;; 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 H0) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f)))
#|
;; An H0 implementation.
@see http://www.radford.edu/itec380/2025spring-ibarland/Homeworks/Project/H0.html

@author ibarland@radford.edu
@version 2025-apr-12
@original-at http://www.radford.edu/itec380/2025spring-ibarland/Homeworks/Project/H0.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> | <Paren> | <BinOp> | <IfZero> | <Nop>
<Paren>  → shake <Expr> bake                     Interpretation: a parenthesized expression
<BinOp>  → add <Expr> to <Expr>                  Interpretation: addition
<BinOp>  → skim <Expr1> off <Expr2>              Interpretation: subtract <Expr>1 from <Expr>2 (note the order!)
<BinOp>  → scale <Expr> to serve <Expr>          Interpretation: multiplication
<IfZero> → sample <Expr1>; add <Expr2> to taste or use <Expr3> instead    Interpretation: if <Expr>1 is 0 (within 1e-6), eval to Expr2, else Expr3.



// To be added in H1: see H2.html for details
<BinOp>  → chop <Expr>1 into <Expr>2 Interpretation: “remainder”, except works for negative and fractional amounts.  See H2.html for details.
<Expr>   → … | <IfLT+>                            Interpretation: “if less-than, add …”
<IfLT+>   → to be announced.

// To be added in H2: see H2.html for details
<Expr>    → … | <Id> | <LetExpr>                Interpretation: identifier; let
<LetExpr> → garnish <Id> with <Expr> for <Expr> Interpretation: bind Id to result of 1st Expr (the right-hand-side); then eval 2nd body Expr w/ that binding
|#


; our parse tree for
;     broil shake add 2 to 3 bake for 4 minutes         (aka  `(2+3)*4` )
; is:
;     <draw on board in class>
;
; Our internal representation of that tree will be:
;   (make-binop "broil" (make-paren (make-binop "add" 2 3)) 4)



(define OP-FUNCS (list (list "add"   +)
                       (list "skim"  (fn (a b) (- b a))) ; just like `-`, but in other order!
                       (list "scale" *)
                       ))
(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?)  ; N.B.  H4 will upgrade our notion of 'value' to include *functions*, as well as numbers.




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



; 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 H0-tests.rkt, for test-cases
;;;

; Return the value which `e` evaluates to.
; In H0, the only type of `value?`s are `number?`s.
;
(define/contract (eval e)
  (-> expr?  number?)
  (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 "add"  3 2) 5)
(check-expect (eval-binop "skim" 3 2) -1)
(check-expect (eval-binop "scale" 3 2) 6)
;;;
;;; See H0-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 "add")   (+ l r)]
           [(string=? op "skim")  (- r l)] ;hmm, different argument-order
           [(string=? op "broil") (* l r)]
           [else (error 'eval "Unimplemented op " op)])
   ;
   ; *** In your H1/H2 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 (binop-op e) " "
                                   (expr->string (binop-left e)) " "
                                   (match (binop-op e)
                                     ["add"  "to "]
                                     ["skim" "off "]
                                     ["scale" "to serve "]
                                     [_ (error 'expr->string "unhandled binop" (binop-op e))])
                                   (expr->string (binop-right e))
                                   )]
        [(paren? e) (string-append "shake" " " (expr->string (paren-e e)) " " "bake")]
        [(if-zero? e) (string-append "sample "
                                     (expr->string (if-zero-tst e))
                                     "; add "
                                     (expr->string (if-zero-thn e))
                                     " to taste or use "
                                     (expr->string (if-zero-els e))
                                     " instead"
                                     )]
        [else (error 'expr->string "unknown type of expr: " e)]))


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


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

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

; Given a scanner, consume one H0 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)]
        [(member (peek s) OPS) (parse-binop! s)]
        [(string=? "shake" (peek s))
         (let* {[_ (check-token= (pop! s) "shake")]  ; consume the '(' off the input-stream
                [the-inside-expr (parse! s)]         ; recursively consume one whole Expr (no matter how long) 
                [_ (check-token= (pop! s) "bake")]   ; consume the trailing ')'
                }
           (make-paren the-inside-expr))]

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


; Given a scanner, consume one H0 BinOp off the front of it
; and return the corresponding parse-tree.
;
(define/contract (parse-binop! s)
  (-> scanner?   binop?)
  (cond [(string=? "add" (peek s))  
         (let* {[op     (pop! s)]
                [lefty  (parse! s)]
                [_ (check-token= (pop! s) "to")]
                [righty (parse! s)]
                }
           (make-binop op lefty righty))]
        [(string=? "skim" (peek s))  
         (let* {[op     (pop! s)]
                [lefty  (parse! s)]
                [_ (check-token= (pop! s) "off")]
                [righty (parse! s)]
                }
           (make-binop op lefty righty))]
        [(string=? "scale" (peek s))  
         (let* {[op     (pop! s)]
                [lefty  (parse! s)]
                [_ (check-token= (pop! s) "to")]
                [_ (check-token= (pop! s) "serve")]
                [righty (parse! s)]
                }
           (make-binop op lefty righty))]
        [else (error 'parse-binop "unhandled op: " (peek s))]))


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

 And then `parse-binop` etc are each in their own class.
 (Pitfall: They simply need to be sure to recur on `Expr.parse`;
  if they just call `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 H2-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.
;;;;

(check-expect (string->expr "skim 3 off 7")
              (make-binop "skim" 3 7))

(check-expect (expr->string (make-binop "skim" 3 7))
              "skim 3 off 7")


#|   These examples/tests are for in-class discussion.
     See `H0-tests.rkt` for more thorough and systematic test cases.


; Examples of Expr:
34
(make-paren 34)
(make-binop "add" 3 4)  
(make-binop "add" (make-paren 34) (make-binop "skim" 3 4))
; "add shake 34 bake to skim 3 off 4"

(make-if-zero 3 7 9)

(make-if-zero (make-paren 1)
              (make-binop "add" (make-paren 34) (make-binop "skim" 3 4))
              (make-if-zero 0 7 9))


(define a-prog "sample           shake 1 bake
                ; add            add shake 34 bake to skim 3 off 4
                to taste or use  sample 0; add 7 to taste or use 9 instead
                instead")
(check-expect (string->expr a-prog)
              (make-if-zero (make-paren 1)
                            (make-binop "add" (make-paren 34) (make-binop "skim" 3 4))
                            (make-if-zero 0 7 9)))

(check-expect (expr->string (string->expr a-prog))
              #;a-prog
              ; Note: expr->string, string->expr aren't *exact* inverses: may differ in whitespace!
              (regexp-replace* #px" ;"
                               (regexp-replace* #px"\\s+" a-prog " ")
                               ";"))
|#