;; The first three lines of this file were inserted by DrRacket. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname F0) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f)))
#|
;; A F0 implementation.
@see http://www.radford.edu/itec380/2024spring-ibarland/Homeworks/Project/F0.html

@author ibarland@radford.edu
@version 2024-apr-03
@original-at http://www.radford.edu/itec380/2024spring-ibarland/Homeworks/Project/F0.rkt

@license CC-BY -- share/adapt this file freely, but include attribution, thx.
    https://creativecommons.org/licenses/by/4.0/ 
    https://creativecommons.org/licenses/by/4.0/legalcode 
Including a link to the *original* file satisifies "appropriate attribution".
|#

(require "student-extras.rkt")
(require "scanner.rkt")
(provide (all-defined-out))

#|
<Expr>      ->  <Num> | <BinOp> | <ParenExpr> | <IfZero> // interpretation: a parenthesized expression
<BinOp>     ->  tilt <Expr> <Op> <Expr>                  // interpretation: apply a binary operator  Note: infix
<Op>        ->  sum | wntr | spr                         // interpretation: add, subtract, multiply  
<ParenExpr> ->  ( <Expr> )                               // interpretation: parenthesized expression
<IfZero>    ->  if <Expr> equinox <Expr> : <Expr>        // interpretation: if 3rd expr is zero, answer is the 1st expr, else use the 2nd expr



// To be added in F1:
<IfLT>      ->  lunar <Expr> phase <Expr> was <Expr> wane <Expr>     // Interpretation: "if less-than": expr1 < expr2  ?  expr3  : expr4

// To be added in F2:
<LetExpr>   ->  moon <Id> on <Expr> eclipses <Expr>  // Interpretation: bind Id to the val of "right-hand-side" (1st) expr, within scope of "body" (2nd) expr
|#


; our parse tree for
;     tilt (tilt 2 sum 3) spr 4         (aka  `(2+3)*4` )
; is:
;     <draw on board in class>
;
; Our internal representation of that tree will be:
;   (make-binop "spr" (make-paren (make-binop "sum" 2 3)) 4)



(define OP-FUNCS (list (list "sum"  +)
                       (list "wntr" -)
                       (list "spr"  *)
                       ))
(define OPS (map first OP-FUNCS))

; datatype defn:
(define (op? val) (member val OPS))


; datatype defn
(define (expr? v) #;(or/c number? binop? paren? if-zero?)
  (or (number? v)
      (binop? v)
      (paren? v)
      (if-zero? v)))


(define-struct/c binop ([op op?] [left expr?] [right expr?]))   ; NOTE: `op` is our *first* field, despite our infix syntax.
(define-struct/c paren ([e expr?]))
(define-struct/c if-zero ([tst expr?] [thn expr?] [els expr?]))

(define value? number? val)  ; N.B.  F4 will upgrade our notion of 'value' to include *functions*, as well as numbers.




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


; Examples of Expr:
34
(make-paren 34)
(make-binop "sum" 3 4)
(make-binop "sum" (make-paren 34) (make-binop "wntr" 3 4))  ; 
(make-if-zero 3 7 9)
(make-if-zero (make-paren 1)
              (make-binop "sum" (make-paren 34) (make-binop "spr" 3 4))
              (make-if-zero 0 7 9))
; the above is the parse-tree for:  if (1) equinox tilt 34 sum tilt 3 spr 4  : if (0) equinox 7 : 9

; Template, for *any* function handling an Expr:
; 
(define/contract (func-for-expr e)
  (-> expr?  ...?)
  (cond [(number? e) ...]
        [(binop? e) (... (binop-op e)
                         (func-for-expr (binop-left e))
                         (func-for-expr (binop-right e)))]
        [(paren? e) (func-for-expr (paren-e e))]
        [(if-zero? e) (... (func-for-expr (if-zero-tst e))
                           (func-for-expr (if-zero-thn e))
                           (func-for-expr (if-zero-els e)))]))


;;;;;;;;;;;;;;;;;;;;;;;;;; *evaluate* an expr ;;;;;;;;;;;;;;;;;;;;;;

;;;
;;; See F0-tests.rkt, for test-cases
;;;

; Return the value which `e` evaluates to.
; In F0, the only type of `value?`s are `number?`s.
;
(define/contract (eval e)
  (-> expr?  value?)
  (cond [(number? e) e]
        [(binop? e) (let* {[the-op    (binop-op e)]
                           [left-val  (eval (binop-left  e))]
                           [right-val (eval (binop-right e))]
                           }
                      (eval-binop the-op left-val right-val))]
        [(paren? e) (eval (paren-e e))]
        [(if-zero? e) (if (zero? (eval (if-zero-tst e)))
                          (eval (if-zero-thn e))
                          (eval (if-zero-els e)))]
        [else (error 'eval "unknown type of expr: " (expr->string e))]))



(check-expect (eval-binop "sum"  3 2) 5)
(check-expect (eval-binop "wntr" 3 2) 1)
(check-expect (eval-binop "spr"  3 2) 6)
;;;
;;; See F0-tests.rkt, for more test-cases
;;;

; Implement the binary operators.
;
(define/contract (eval-binop op l r)
  (-> op? number? number?  number?)  
  ; We just look up `op` in the list `OP-FUNCS`, and use the function that's in that list.
  (let* {[ops-entry (assoc op OP-FUNCS)]}
         ; OPS is a list of list-of-string-and-func;
         ; so `(second ops-entry)` is a function (if ops-entry is found at all).
    (cond [(cons? ops-entry) ((second ops-entry) l r)]
          [else (error 'eval-binop "Unimplemented op " op "; most be one of: " OPS)])))

   ; An alternate implementation -- forces us to repeat
   ; the string-constants already in OPS:
   #;(cond [(string=? op "-") (+ l r)]
           [(string=? op "+") (- l r)]
           [(string=? op "/") (* l r)]
           [else (error 'eval "Unimplemented op " op)])
   ;
   ; *** In your F1/F2 submission, DELETE whichever eval-binop approach you don't use.






; Return a string-representation of `e`.
;
(define/contract (expr->string e)
  (-> expr? string?)
  (cond [(number? e) (number->string (if (integer? e) e (exact->inexact e)))]
        [(binop? e) (string-append "tilt" " "
                                   (expr->string (binop-left e))
                                   " "
                                   (binop-op e)
                                   " "
                                   (expr->string (binop-right e))
                                   )]
        [(paren? e) (string-append "(" (expr->string (paren-e e)) ")")]
        [(if-zero? e) (string-append "if "
                                     (expr->string (if-zero-tst e))
                                     " equinox "
                                     (expr->string (if-zero-thn e))
                                     " : "
                                     (expr->string (if-zero-els e))
                                     )]
        [else (error 'expr->string "unknown type of expr: " e)]))


;;;;;;;;;;;;;;;;;;;;;;;;;;;; parsing ;;;;;;;;;;;;;;;;;;;;


;;;
;;; See F0-tests.rkt, for test-cases
;;;

; given a string, return the parse-tree for the F0 expression at its front.
;
(define/contract (string->expr prog)
  (-> string? expr?)
  (parse! (create-scanner prog)))


; Given a scanner, consume one F0 expression off the front of it
; and return the corresponding parse-tree.
;
(define/contract (parse! s)
  (-> scanner? expr?)
  ; Recursive-descent parsing:
  (cond [(number? (peek s)) (pop! s)]
        
        [(string=? "tilt" (peek s))
         (let* {[_ (check-token= (pop! s) "tilt")]  ; consume "tilt" off front of input
                [lefty  (parse! s)]
                [op     (pop! s)]
                [_ (if (not (member? op OPS))
                       (error 'parse! "Unknown op " op)
                       'keep-on-going)]
                [righty (parse! s)]
                }
           (make-binop op lefty righty))]
        
        [(string=? "(" (peek s))
         (let* {[_ (check-token= (pop! s) "(")]   ; consume the '(' off the input-stream
                [the-inside-expr (parse! s)]      ; recursively consume one whole Expr (no matter how long) 
                [_ (check-token= (pop! s) ")")]   ; consume the trailing ')'
                }
           (make-paren the-inside-expr))]

        [(string=? "if" (peek s))
         (let* {[_ (check-token= (pop! s) "if")] 
                [test (parse! s)]
                [_ (check-token= (pop! s) "equinox")]
                [the-then-ans (parse! s)]
                [_ (check-token= (pop! s) ":")]
                [the-else-ans (parse! s)]
                }
           (make-if-zero test the-then-ans the-else-ans))]
        
        [else (error 'parse! (format "syntax error -- something has gone awry!  Seeing ~v." (peek s)))]))

#| Our java version of `parse` corresponds more to:
(define/contract (parse! s)
  (-> scanner? expr?)
  (cond [(number? (peek s))         (parse-number s)]
        [(string=? "(" (peek s))    (parse-paren s)]
        [(string=? "tilt" (peek s)) (parse-binop s)]
        [(string=? "if" (peek s)))  (parse-if-zero s)]))

 And then `parse-binop` etc are each in their own class.
 (They simply need to be sure to recur on `Expr.parse`;
  if they just write `parse` they'll get, say, `Binop.parse`
  which is not general enough.)
|#




;;;;;;;;;;;;;; some small,miscellaneous helpers ;;;;;;;;;;;;;;;;;


; datatype definition:
(define token? (or/c string? number?))

(define/contract (check-token= actual-token expected-token)
  (-> token? token?  token?)
  ; Verify that `actual-token` equals `expected-token`; throw an error if not.
  ; IF they are equal, just return `actual-token` (as a convenience-value).
  ;
  (if (equal? actual-token expected-token)
      actual-token
      (error 'check-token= (format "Expected the token ~v, but got ~v." expected-token actual-token))))




;;;; testing expr->string, string->expr on some simple exprs.
;;;; These are NOT complete tests; see F2-test.rkt for that.
;;;; But this IS a handy place to quickly test new types of exprs
;;;; and catching silly mistakes, before running the detailed tests.
;;;;
(map (compose expr->string string->expr)
     '("tilt 2 sum 3"
       ;"tilt (34) wntr tilt 3 spr 4"
       "if 2 equinox 3 : 4"
       ;"if if 3 equinox 7 : 9 equinox tilt (34) wntr tilt 3 spr 4 : 55"
       #;"if      tilt (34) wntr tilt 3 spr 4
        equinox if 7 equinox 9 : if 4 equinox 5 : 6
        :       (34)"
       ))