#lang racket
; http://www.radford.edu/itec380/2013fall-ibarland/Homeworks/hw06.html
; Ian Barland, 2008.Nov.27

; We'll run this program in language-level 'Racket', *not* 'Advanced Student'.
; (This is because we are exporting our functions
;  as a module, so the test-cases can use them.)

; This next line exports all functions
; (in Java terms: a package where everything is public).
; Alternately, you could `provide` just the specific names you wanted public.
;
(provide (all-defined-out))

(require "scanner.rkt")  ; scanner.rkt must be in the same dir as this file.
(require test-engine/scheme-tests)


;;;;;;;;;;; language O0 ;;;;;;;;;;;;;;

; An Expr is one of:
; - a number
; - (make-paren-expr [Expr])
; - (make-bin-expr [Expr] [Bin-op] [Expr])
; - (make-is0-expr [Expr] [Expr] [Expr])
;
; A Bin-op is a string in the list BIN_OP_TOKENS:
;
(define BIN_OP_TOKENS (list "add" "sub" "mul"))

(define (bin-op? any-val) (member any-val BIN_OP_TOKENS))


(define-struct bin-expr (left op right) #:transparent)
(define-struct paren-expr (e) #:transparent)
(define-struct is0-expr (cond then else) #:transparent)
;
; The keyword 'transparent' makes structs with 'public' fields;
; in particular check-expect can inspect these structs.



; parse!: ( scanner -> expr)
; Return (our internal, parse-tree representation of) the first O0 expr
; at the front of the scanner.
; Side effect: Consumes tokens from scnr corresponding exactly
; to the returned expr.
;
; "recursive descent parsing"
;
(define (parse! scnr)
  (cond [(number? (peek scnr)) (pop! scnr)]
        [(string=? (peek scnr) "if")
         (let* {[open-is0 (pop! scnr)]  ; Pop off the "if" we just peeked at.  Ignore it.
                [subexpr1 (parse! scnr)]
                [the-is0-keyword  (pop! scnr)] ; pop off the "is0";  ignore it.
                [the-then-keyword (pop! scnr)] ; pop off the "then"; ignore it.
                [subexpr2 (parse! scnr)]
                [the-else-keyword (pop! scnr)] ; pop off the "else"; ignore it.
                [subexpr3 (parse! scnr)]
                [the-semicolon (pop! scnr)] ; pop off the ";"; ignore it.
                }
           (make-is0-expr subexpr1 subexpr2 subexpr3))]
        [(string=? (peek scnr) "(")
         ; Hmm, we have *either* a paren-expr, or a bin-expr.
         (let* {[open-paren (pop! scnr)]  ; Pop off the "(" we just peeked at.  Ignore it.
                [subexpr1 (parse! scnr)]  ; Read an *entire* expr, even if deeply nested!
                }
           (if (string=? (peek scnr) ")")
               (begin (pop! scnr)
                      (make-paren-expr subexpr1))
               (let* {[operator (pop! scnr)]
                      [subexpr2 (parse! scnr)]
                      [closing-paren (pop! scnr)]
                      }
                 (when (not (string=? closing-paren ")"))
                   (error 'parse! "Expected ')', got: ~v." closing-paren))
                 (when (not (bin-op? operator))
                   (error 'parse! "Expected one of ~v, got ~v." BIN_OP_TOKENS operator))
                 (make-bin-expr subexpr1 operator subexpr2))))]
         [else (error 'parse! "Unrecognized expr: ~v." (peek scnr))]))

; parse-string: (-> string expr)
; Convert the given string representing exactly *one* single Expr
; into our internal format (structs).
;
(define (parse-string str)
  (parse! (create-scanner str)))


; expr->string : (-> expr string) (a.k.a. toString)
; Return a human-readable version of our internal representaiton of Exprs.
; 
(define (expr->string e)
  (cond [(number? e) (number->string e)]
        [(paren-expr? e) (string-append
                          "("
                          (expr->string (paren-expr-e e))
                          ")"
                          )]
        [(bin-expr? e) (string-append
                        "(" 
                        (expr->string (bin-expr-left e))
                        " "
                        (bin-expr-op e)
                        " "
                        (expr->string (bin-expr-right e))
                        ")"
                        )]
        [(is0-expr? e) (string-append 
                        "if "
                        (expr->string (is0-expr-cond e))
                        " is0 then "
                        (expr->string (is0-expr-then e))
                        " else "
                        (expr->string (is0-expr-else e))
                        ";"
                        )]
        [else (error 'expr->string "unknown internal format?!: ~v" e)]
        ))
        



; eval : (-> expr val)
; Evaluate the given expr.
;
(define (eval e)
  (cond [(number? e) e]
        [(paren-expr? e) (eval (paren-expr-e e))]
        [(bin-expr? e) (eval-bin-expr e)] ; defer to a helper
        [(is0-expr? e)
         (if (= (eval (is0-expr-cond e)) 0)
             (eval (is0-expr-then e))
             (eval (is0-expr-else e)))]
        [else (error 'eval "unknown internal format?!: ~v" e)]))

; eval-bin-expr : (-> bin-expr val)
;
(define (eval-bin-expr e)
  (let* {[left-value  (eval (bin-expr-left  e))]
         [right-value (eval (bin-expr-right e))]
         }
    (cond [(string=? (bin-expr-op e) "add")  (+ left-value right-value)]
          [(string=? (bin-expr-op e) "mul") (* left-value right-value)]
          [(string=? (bin-expr-op e) "sub") (- left-value right-value)]
          [else (error 'eval-bin-expr
                       "Syntax error: unknown binary operator '~a' in ~a."
                       (bin-expr-op e)
                       (expr->string e))])))




#|
Note:
The 'cond' has a bunch of repeated patterns that it'd be nice to factor out.
The first pass would have the cond just choose +,*,-, and we'd apply the result:
((cond [(string=? (bin-expr-op e) "add")  +]
       [(string=? (bin-expr-op e) "mul") *]
       [(string=? (bin-expr-op e) "sub") -])
  left-value
  right-value))

This is pretty good, but we can do better.  Imagine we had a 'lookup' function:
((lookup (bin-expr-op e) (list (list "add"  +)
                               (list "mul" *)
                               (list "sub" -)))
     left-value
     right-value))

; Turns out lookup isn't *quite* built in, 
; but it's easy to make, out of "association lists"
; and the built-in function 'assoc'
;
(define (lookup key a-list) (second (assoc key a-list)))
;  Or just :   (define lookup (compose second assoc))

; I'll leave it for further reading, about how 'assoc' works exactly.


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Digression: backquote, unquote:
We saw that a quote can be used to make a symbol:   'hello
And now, a secret: If you try to "quote a list", the quote distributes over the list:
'(3 4 hi 8)  =  (list 3 4 'hi 8)   ; (Note that 'hi is quoted)
It even works recursively:
'(3 4 (5 6 bye 7) hi 8)  = (list 3 4 (list 5 6 'bye 7) 'hi 8)
                  ; That's a list-of-length-five, the middle of which is itself a list-of-length-four.

;  "Lisp" = "list processing"
;
; Back to quoting a list: What if one of the things in the list is a variable, like pi?
'(hi 3 "howdy" pi)  =  (list 'hi 3 "howdy" 'pi)
; Rats, we get the *symbol* 'pi (just like we did for 'hi), not 3.14.
; 
; THe cool solution: We can use back-quote, which allows *unquote* (comma):
`(hi 3 "howdy" ,pi) = (list 'hi 3 "howdy" 3.14159)
; We can unquote *any* expression:
`(hi 3 "howdy" ,(* pi 100))  = (list 'hi 3 "howdy" 314.159)
;
; Anything being unquoted is a perfectly fine expression.
; It might even contain a backquote itself (which can of course contain an unquote (comma) ...

`(hi 3 ,(map sqrt `(16 25 ,(* 100 pi))) "hello")  = ???

; [typographically, note how command and backquote do look kinda opposite/mirror-image...]
; Once you've digested all that, you can read about unquote-splice.

; Note that quoting a list, unquote and unquote splice
; All get rewritten into (primitive)quote-symbol, `list`, and `append` functions.
; They're just shortcuts -- handy, but nothing we couldn't do before.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Where were we?
Oh right, 
((lookup (bin-expr-op e) (list (list "add"  +)
                               (list "mul" *)
                               (list "sub" -)))
     left-value
     right-value))

The association-list (list of key/value pairs) can be written more concisely using backquote:

((lookup (bin-expr-op e) `(("add"  ,+)
                           ("mul" ,*)
                           ("sub" ,-)))
     left-value
     right-value))

; Note that that (a) we really need the comma there:
;  we want the list to contain the-actual-multiplication-function,
;  not just an asterisk-symbol.
; and (b) an association-list containing functions is very convenient
; (esp. w/ λ).


|#

              


;;;;;;;;;;;;;;;;;;; TEST CASES: O0 ;;;;;;;;;;;;;;;;
;;; The following list gets used by 'O-test-helpers.rkt':

(define tests
  ; Each entry in the list is either
  ; [str val] (where val is the result of interpreting the string str), or
  ; [str val expr] (as above, but expr is the internal (struct) representation).
  `{["7" 7 7]
    ["(3 add 4)" 7 ,(make-bin-expr 3 "add" 4)]
    ["(3 mul   4)" 12 ,(make-bin-expr 3 "mul" 4)]
    ["((3 add 4) add(  3  mul 4 ))" 19]
    ["if 0 is0 then 1 else 2;" 1 ,(make-is0-expr 0 1 2)]
    ["if 1 is0 then 1 else 2 ;" 2 ,(make-is0-expr 1 1 2)]
    ["if (3 add -3) is0 then 1 else 2;" 1 ,(make-is0-expr (make-bin-expr 3 "add" -3) 1 2)]
    ["if (if if 0 is0 then 1 else 2; is0 then 3 else 4 ; add -3) is0 then  1 else 2;" 
     2
     ,(make-is0-expr (make-bin-expr (make-is0-expr (make-is0-expr 0 1 2) 3 4) "add" -3) 1 2)]
    })

; Some expressions to test in a non-automated way:
(define e0 "43")
(define e1 "(43)")
(define e2 "(4 add 3)")
(define e3 "((((4 add 3))))")
(define e4 "((43) add    (  42 mul 3))")


(check-expect (parse-string "39") 39)
(check-expect (parse-string "(4 add 3)") (make-bin-expr 4 "add" 3))
(check-expect (eval (parse-string "(4 add 3)")) 7)

(check-expect (eval (parse-string e4)) 169)

(check-error (parse-string "()") "parse!: Unrecognized expr: \")\".")
(test)  ; This call actually *runs* the tests
        ; that have been previously registered via check-expect.