;; 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-advanced-reader.ss" "lang")((modname hw8) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #t #t none #f () #f)))
;;; Homework 8
;;; Due Wednesday 2016/12/7 11pm
;;; See instructions at end of file.

;;; NOTE: this is version 2 of this assignment. The original version had a bug
;;; in the "run" function (see comments in the function below).

;;; Language: Advanced Student
(require racket/vector)

;;; Token stream
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; A simple token-stream input source, that provides 1-token lookahead.

;;; Data definition:
;;; Token = Number | 'lparen | 'rparen | '+ | '- | '* | 'read

;;; The token stream.
(define *stream* '())

;;; Tokens -> Undefined
;;; Load up the token stream with the given list of tokens.
(define (load-token-stream! tokens)
  (set! *stream* tokens))

;;; -> Token
;;; Return the next token in the stream, but do not remove it from the
;;; stream. End-of-stream is signalled with the symbol 'eos.
(define (peek)
  (if (empty? *stream*) 'eos
      (first *stream*)))

;;; -> Undefined
;;; Remove and discard the next token from the input stream. Returns
;;; no interesting value; call only for side effect.
(define (drop-input!)
  (if (not (empty? *stream*))
      (set! *stream* (rest *stream*))
      false))

;;; -> Token
;;; Remove the next token from the input stream and return it.
;;; Return 'eos if at end of stream.
(define (gobble)
  (let ((token (peek)))
    (begin (drop-input!)
           token)))

;;; [Token -> Boolean] -> Token
;;; Remove the next token from the input stream and check to ensure it
;;; satisfies the given test. Return the token if yes; raise an error if no.
;;; Return 'eos if at end of stream.
(define (gobble/check check)
  (let ((actual (gobble)))
    (if (check actual) actual
        (error 'gobble/check "Illegal token" actual))))

(check-expect (begin (load-token-stream! '(3 +))
                     (let* ((t1 (peek))
                            (t2 (gobble))
                            (t3 (gobble))
                            (t4 (gobble))
                            (t5 (gobble)))
                       (equal? (list t1 t2 t3 t4 t5)
                               '(3 3 + eos eos))))
              #t)

;;; Arithmetic-expression language & parser
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Grammar                     Data definition
;;; ;;;;;;;                     ;;;;;;;;;;;;;;;
;;; E     -> T ETail            Expr = (make-exp Term ETails)
;;; ETail -> Addop T ETail      ETails = [Listof (make-etail Addop Term)]
;;;        |
;;; Addop -> + | -              Addop = '+ | '-
;;;
;;; T     -> F TTail            Term = (make-term Factor TTails)
;;; TTail -> * F                TTails = [Listof Factor]
;;;        |
;;;
;;; F     ->                    Factor is one of:
;;;          read               - 'read (Prompt for an input from the user)
;;;        | number             - Number
;;;        | ( E )              - Expr
;;;
;;; This mutually-recursive data-def is a tree.
;;; Trees can be easily processed w/recursive code...

(define-struct expr  [term1 etails])
(define-struct etail [op term])
(define-struct term [factor ttails])

;;; -> Expr
;;; Parse one expression from the input token stream.
(define (parse-expr)
  (let ((t1 (parse-term)))
    (make-expr t1 (parse-etail))))

(define (parse-etail)
  (let ((next (peek)))
    (if (or (symbol=? '+ next)
            (symbol=? '- next))
      (let* ((op   (gobble))
             (term (parse-term))
             (tail (parse-etail)))
        (cons (make-etail op term) tail))
      '())))

(define (parse-term)
  (let ((f (parse-factor)))
    (make-term f (parse-ttail))))

(define (parse-ttail)
  (if (symbol=? '* (peek))
      (begin (gobble)
             (let ((f (parse-factor)))
               (cons f (parse-ttail))))
      '()))

(define (parse-factor)
  (let ((next    (peek))
        (rparen? (lambda (tok) (equal? tok 'rparen))))
    (cond [(number? next)       (gobble)]
          [(equal? next 'read)  (gobble)]
          [(equal? next 'lparen)
           (begin (gobble)
                  (let ((e (parse-expr)))
                    (begin (gobble/check rparen?)
                           e)))]
          [else (error 'parse-factor "Illegal factor" next)])))


(check-expect (begin (load-token-stream! '(lparen read + 2 rparen * 5))
                     (parse-expr))
              (make-expr (make-term (make-expr (make-term 'read '())
                                               (list (make-etail '+ (make-term 2 '()))))
                                    (list 5))
                         '()))


;;; Virtual machine
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Here is a simple virtual machine. The machine computes using a stack.
;;; Individual instructions consume values from the stack and push their
;;; results on the stack. So, for example, if the stack looks like this:
;;;     3 1 7 0 -5 ...
;;; where 3 is the value on the top of the stack, then executing the addition
;;; instruction pops the 3 and the 1 off the stack, adds them together,to
;;; produce 4, and pushes this back onto the stack, giving a final stack of
;;;     4 7 0 -5 ...
;;; The machine can add, subtract, multiply, push constants, and read
;;; input values from the user.
;;;
;;; Data definitions:
;;;
;;; An Instruction is one of:
;;;   Data                      Interpretation
;;;   ----                      --------------
;;; - Number                    ; Push numeric constant on the stack
;;; - '+                        ; Pop 2 numbers, push sum
;;; - '-                        ; Pop 2 numbers, push diff
;;; - '*                        ; Pop 2 numbers, push prod
;;; - read                      ; Read a number from input & push it.
;;;
;;; Note that the subtraction instruction computes x - y, where y is
;;; the value on the top of the stack and x is the value just under
;;; the top of the stack. (NOTE: the original version of this assignment
;;; reversed that order, but this one fixes it so that both side effects
;;; and subtraction happen in the expected order without jumping through
;;; lots of hoops).
;;;
;;; Code = [Vectorof Instruction]
;;; Note: a constant vector is written with hash-parenthesis, e.g.: #(a b c).
;;; We access element i of a vector v with (vector-ref v i).
;;; We append two vectors with (vector-append v1 v2).
;;; We construct a vector from given elements with (vector e1 e2 e3),
;;; analogously to (list e1 e2 e3).

(define test-prog1 '#(4 5 + 2 *))       ; Compute (4+5) * 2.
(define test-prog2 '#(2 read *))        ; Prompt for a number & double it.

;;; Code -> Number
;;; Execute the program, returning the top of the stack when done.
(define (run prog)
  ;; Machine state is the current program counter and the run-time stack.
  ;; The stack is represented as a list of values; cons is push; rest is pop.
  (local [(define (exec pc stack)
            ;; We are done when we fall off the end of the program.
            ;; The final answer is whatever is on top of the stack.
            (if (>= pc (vector-length prog))
                (first stack)

                (let ((insn (vector-ref prog pc)) ; Fetch the current insn.
                      (next (+ pc 1)))            ; Advance the PC.

                  (cond [(number? insn)           ; Push constant on stack.
                         (exec next (cons insn stack))]

                        ;; Pop two operands off top of stack,
                        ;; do the operation, and push the result.
                        [(member insn '(+ - *))
                         ;; NOTE: arguments a1 and a2 are flipped from the original assignment
                         (let* ((a1 (second stack))
                                (a2 (first stack))
                                (popped-stack (rest (rest stack)))
                                (op (cond [(symbol=? insn '+) +]
                                          [(symbol=? insn '-) -]
                                          [(symbol=? insn '*) *]))
                                (result (op a1 a2)))
                           (exec next (cons result popped-stack)))]

                        ;; Prompt for a number & push it on the stack.
                        [(equal? insn 'read)
                         (exec next (cons (read-input) stack))]

                        [else (error 'run "Illegal instruction: " insn)]))))]

         ;; Start the program at pc=0 with an empty stack.
         (exec 0 '())))

(define (read-input)
  (begin
    (display "? ")
    (read)))

(check-expect (run test-prog1) 18)      ; (4+5)*2 = 18.


;;; A simple compiler
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This compiler recursively walks an expression tree, translating it
;;; to code that can be executed on the virtual machine.

;;; Here is the grammar, again, for reference:
;;; Grammar                     Data definition
;;; ;;;;;;;                     ;;;;;;;;;;;;;;;
;;; E     -> T ETail            Expr = (make-exp Term ETails)
;;; ETail -> Addop T ETail      ETails = [Listof (make-etail Addop Term)]
;;;        |
;;; Addop -> + | -              Addop = '+ | '-
;;;
;;; T     -> F TTail            Term = (make-term Factor TTails)
;;; TTail -> * F                TTails = [Listof Factor]
;;;        |
;;;
;;; F     ->                    Factor is one of:
;;;          read               - 'read (Prompt for an input from the user)
;;;        | number             - Number
;;;        | ( E )              - Expr

(define @ vector-append) ; convenient abbreviation

;;; Expr -> Code
;;; Produce code to compute the given expression.
(define (compile-expr e)
  (@ (compile-term (expr-term1 e))              ; Compute 1st term,
     (foldr (lambda (et code)                   ; then do
              (@ (compile-etail et) code))      ; each computation
            '#()
            (expr-etails e))))                  ; in the etail


;;; (make-etail Addop Term) -> Code
;;; Produce code to compute the given etail item.
(define (compile-etail et)
  ...)

;;; Term -> Code
;;; Produce code to compute the given term.
(define (compile-term t)
  ...)

;;; Factor -> Code
;;; Produce code to compute the given factor.
(define (compile-factor f)
  ...)

;;; (4*5) - (read*3)
(check-expect (compile-expr
               (make-expr (make-term 4 (list 5))
                          (list (make-etail '- (make-term 'read (list 3))))))
              '#(4 5 * read 3 * -))

;;; This etail term corresponds to the expression fragment ... - (read * 3).
(check-expect (compile-etail (make-etail '- (make-term 'read (list 3))))
              '#(read 3 * -))

(check-expect (compile-term (make-term 'read (list  3))) ; Compile "read * 3".
              '#(read 3 *))

(check-expect (compile-factor 3) '#(3))

;;; End to end test: parse, compile & run "(4+5)*2", producing 18. Yahoo.
(check-expect (begin (load-token-stream! '(lparen 4 + 5 rparen * 2))
                     (run (compile-expr (parse-expr))))
              18)


;;; Questions (graded)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; - We have provided the definition of the compile-expr function,
;;;   along with the signature, purpose statement and tests for the
;;;   compile-etail, compile-term and compile-factor functions. Please
;;;   finish the compiler: write these three functions.


;;; Questions (ungraded, difficulty: straightforward but fun)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; - Extend the machine with branch instructions:
;;;     + (jump <number>)       ; Jump forward/backward by <number> insns.
;;;                             ; That is, pc -> pc + <number>.
;;;     + (jump-if <number>)    ; Pop boolean off stack and jump if true.
;;;                             ; If false, proceed to following insn, that
;;;                             ; is, pc -> pc+1.
;;;
;;; - Extend the machine with boolean instructions to
;;;   go with the jump-if conditional-branch instruction:
;;;     '<              ; Pop two numbers, compare with < and push boolean.
;;;     'and            ; Pop two booleans, push their and.
;;;   ...likewise for or, not, >, =, <=, >=
;;;
;;; - Extend the grammar of the original language and its syntax-tree
;;;   data-definition to provide an if/then/else/end expression and
;;;   numeric comparisons:
;;;      3 + if read < 0 then 5 else 7 end * 2
;;;
;;; - Extend the compiler to compile the extended expression language.
;;;
;;; - Write a type checker that can determine if all arguments to
;;;   numeric functions are numbers, and all arguments to boolean
;;;   functions are booleans; modify the compiler so that it reports
;;;   an error on ill-typed expressions, only compiling programs that
;;;   will not produce run-time errors when executed on the virtual machine.


;;; Questions (ungraded, difficulty: moderate)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; - Extend your expression language to add lambda expressions, recursive
;;;   binding, types, macros, structs, and side effects to variables. Modify
;;;   your compiler to translate your extended language to a suitably extended
;;;   version of the virtual machine. Then use your language's macro facility
;;;   to define any remaining elements of Racket. Print out your code and
;;;   bring a copy to Prof. Shivers or one of the course TAs, who will write
;;;   "Does more than required" at the top and award you an extra 3 points for
;;;   this assignment.