;;; Written in PLT Scheme.
;   - should work in at least version 209 and higher
;
;   See  http://drscheme.org
;
;   Can run from command line as:
;
;     mzscheme --script check.scm < Bad.sexp


; Get some procedures from list library.
;   http://srfi.schemers.org/srfi-1/
;
; Recent versions of PLT Scheme can be more precise about imports:
;   (require (only (lib "1.ss" "srfi") first second filter any))
;
(require (lib "1.ss" "srfi"))
;
; Get some macros from pattern-matching library.
;   http://download.plt-scheme.org/doc/370/html/mzlib/mzlib-Z-H-27.html#node_chap_27
;
; For some examples from CSC 324 2006 Fall:
;   http://www.cs.toronto.edu/~gfb/csc324/2006F/branching
;
; So far we use patterns composed of: _, string and symbol literals, lists, ., or, ?,
;  ..., binding, equality from binding.
;
;(require (only (lib "match.ss") match-lambda))
;
(require (lib "match.ss"))
;
; Use my libraries for matching and treating sexps as trees.
;
(require "matching.ss")
(require "sexp-tree.ss")
(require "list.ss")

;;; Check: Various about Boolean Expressions
;
; - helper that matches literal true or false
;
(define t/f?
  (match?-lambda
    ((expr
       (xor_expr
         (and_expr
           (shift_expr
             (arith_expr
               (term (factor (power (atom (name (or "True" "False"))))))))))))))
;
;  The checks ...
;
(define compares-boolean-literal?
  (match?-lambda
    ((comparison .
      (or 
        ((? t/f?) (comp_op (or (eqequal "==") (notequal "!="))) _)
        (_ (comp_op (or (eqequal "==") (notequal "!="))) (? t/f?)))))))

(define operates-on-boolean-literal?
  (match?-lambda
    (('LNOT (? t/f?)))
    (((or 'LAND 'LOR) .
        (or ((? t/f?) _)
            (_ (? t/f?)))))))
;
(define if-then-returns-boolean-literal?
  (match?-lambda
    (("if" _
      (or          ("return" ('EXPR (? t/f?)))
          ('SLIST  ("return" ('EXPR (? t/f?)))))
      (or          ("return" ('EXPR (? t/f?)))
          ('SLIST  ("return" ('EXPR (? t/f?)))))))))
;
(define distributed-boolean?
  (match?-lambda
    ((or ('LOR  ('LAND e11 e12) ('LAND e21 e22))
         ('LAND ('LOR  e11 e12) ('LOR  e21 e22)))
     (or (equal? e11 e21) (equal? e11 e22) (equal? e12 e21) (equal? e12 e22)))))


;;; Check: Repeated statement at beginning/end of both branches of an if.
;
;   The statement should simply be moved out of the if to before or after it,
;    except where:
;
;     the repeated statement is at the beginning of the branches, and
;      side-effects in the condition or statement can affect each other.
;
;   It's impossible to do in general, so for the moment we do no analysis
;    to avoid flagging the exceptional case. It can still be changed to:
;
;     boolean condition = <condition>;
;     <repeated-statement>;
;     if (condition) {
;        ... // without <repeated-statement>
;     } else {
;        ... // without <repeated-statement>
;     }
;
;   In the implementation, consider canonicalizing single statements to statement lists.
;    This could also shorten other if checks. 
;
(define should-lift-from-if-then?
  (match?-lambda
    (("if" _ .
      (or
        (s              s             )

        (s              ('SLIST s . _))
        (('SLIST s . _) s             )
        (('SLIST s . _) ('SLIST s . _))

        (s                ('SLIST _ ... s))
        (('SLIST _ ... s) s               )
        (('SLIST _ ... s) ('SLIST _ ... s))
)))))


;;; Check: Consecutively Declaring and Initializing a Variable
;
(define two-piece-initialization?
  (match?-lambda
    (('SLIST . r) (any (match?-lambda
                         ((('VARIABLE_DEF _ _ v)
                         ('EXPR ('ASSIGN v _)))))
                    (pairs-overlapped r)))))


;;; Embedded line number handling
;
;
(define (line-number s)
  (find number?
    (map (match-lambda ((_ _ (and (? number?) l)) l) (_ #f))
      (sexp->list-of-subtree-sexps s))))
;
(define (strip-line-numbers s)
  (match s
    ((s0 s1 (? number?)) `(,s0 ,s1))
    ((? list?) (map strip-line-numbers s))
    (_ s)))

(define (line-numbers-of check code)
  (map line-number
    (filter (lambda (s) (check (strip-line-numbers s)))
      (sexp->list-of-subtree-sexps code))))


;;; Running checks
;
;
(define (report-check check message code)
  (let ((line-numbers (line-numbers-of check code)))
    (if (not (null? line-numbers))
      (for-each display `("Line numbers " ,message ":"
                          ,@(map (lambda (l) (string-append " " (number->string l))) line-numbers)
                          ".\n")))))
;
(define checks
  `(;(,operates-on-boolean-literal?
    ;"operating (\"!\", \"&&\" or \"||\") on a boolean literal (\"True\" or \"False\")")
    (,compares-boolean-literal?
     "comparing (\"==\" or \"!=\") with boolean literal (\"true\" or \"false\")")
    ;(,if-then-returns-boolean-literal?
    ; "using if-else to return a boolean literal (\"true\" or \"false\")")
    ;(,distributed-boolean?
    ; "containing && of ||s or || of &&s, with a repeated condition tht can be factored out")
    ;(,two-piece-initialization?
    ; "declaring and initializing as two consecutive statements")
    ;(,should-lift-from-if-then?
    ; "of if-else containing repetition between the two branches")
))
;
(define code (read))
;
; For each check, report each line number where it occurs.
;
(map (match-lambda ((check message) (report-check check message code)))
  checks)