problem-2.rkt

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; part 2
;;; do not modify anything in this file except for calc->asm. You are permitted to
;;; add your own helper functions, structs, etc.

#lang racket
(require rackunit)

(define (valid-reg? k)
  (and (integer? k)
       (>= k 0)
       (<= k 3)))

(define (valid-heap-loc? k)
  (and (integer? k)
       (>= k 0)
       (<= k 50000)))

(define (asm? e)
  (or (Aload? e) (Astore? e) (Asetreg? e) (Atrap? e) (Aadd? e) (Adynamicload? e) (Amul? e) (Ahalt? e)))

;;; set register[reg] = heap[addr]
(struct Aload (reg addr) #:transparent
  #:guard (struct-guard/c valid-reg? valid-heap-loc?))
;;; store register[reg] into heap[addr]
(struct Astore (reg addr) #:transparent
  #:guard (struct-guard/c valid-reg? valid-heap-loc?))
;;; set register[reg] = value
(struct Asetreg (reg value) #:transparent
  #:guard (struct-guard/c valid-reg? integer?))
;;; trap: gives a runtime error if register[0] != v
(struct Atrap (v) #:transparent
  #:guard (struct-guard/c integer?))
;;; set register[0] = register[1] + register[2]
(struct Aadd () #:transparent)
;;; set register[reg] = heap[register[addr]]
(struct Adynamicload (reg addr) #:transparent
  #:guard (struct-guard/c valid-reg? valid-heap-loc?))
;;; set register[0] = register[1] * register[2]
(struct Amul () #:transparent)
;;; terminate
(struct Ahalt () #:transparent)


;;; tracks the state of the CPU
;;; reg : a hashmap of number -> number
;;; heap: a hashmap of number -> number
;;; program: a list of program instructions
;;; insn: a number, the index of the next instruction to be executed
(struct state (reg heap program insn) #:transparent
  #:guard (struct-guard/c hash? hash? (listof asm?) box?))

;;; declare a trap exception that is a subtype of exn:fail
(struct exn:trap exn:fail ())
(define (raise-trap-error)
  (raise (exn:trap
          "trap error"
          (current-continuation-marks))))

;;; new-state : listof asm -> state
;;; create a new program state for program `prog`
(define (new-state prog)
  (state (make-hash) (make-hash) prog (box 0)))

;;; runs an assembly instruction
(define (interp-a s)
  ; this is some handy syntax to combine `define` and pattern matching
  (match-define (state reg heap prog insn) s)
  (define cur-insn (list-ref prog (unbox insn)))
  (match cur-insn
    [(Aload r addr)
     (define v (hash-ref heap addr))
     (hash-set! reg r v)
     (set-box! insn (+ (unbox insn) 1))
     (interp-a s)]
    [(Astore r addr)
     (define v (hash-ref reg r))
     (hash-set! heap addr v)
     (set-box! insn (+ (unbox insn) 1))
     (interp-a s)]
    [(Asetreg r v)
     (hash-set! reg r v)
     (set-box! insn (+ (unbox insn) 1))
     (interp-a s)]
    [(Asetreg r v)
     (hash-set! reg r v)
     (set-box! insn (+ (unbox insn) 1))
     (interp-a s)]
    [(Aadd)
     (define v1 (hash-ref reg 1))
     (define v2 (hash-ref reg 2))
     (hash-set! reg 0 (+ v1 v2))
     (set-box! insn (+ (unbox insn) 1))
     (interp-a s)]
    [(Amul)
     (define v1 (hash-ref reg 1))
     (define v2 (hash-ref reg 2))
     (hash-set! reg 0 (* v1 v2))
     (set-box! insn (+ (unbox insn) 1))
     (interp-a s)]
    [(Adynamicload r l)
     ; set reg[r] = heap[reg[l]]
     (define v (hash-ref heap (hash-ref reg l)))
     (hash-set! reg r v)
     (set-box! insn (+ (unbox insn) 1))
     (interp-a s)]
    [(Atrap v)
     (define reg0-v (hash-ref reg 0))
     (set-box! insn (+ (unbox insn) 1))
     (if (equal? v reg0-v)
         (interp-a s) ; keep going
         (raise-trap-error) ; raise error
         )]
    [(Ahalt)
     ;;; return the contents of register 0
     (hash-ref reg 0)
     ]))

;;; returns #t if running assembly program a results in a trap, false otherwise
(define (traps? a)
  (with-handlers ([exn:trap? (lambda _ #t)])
    (let [(_ (interp-a (new-state a)))]
      #f)))

;;; some small tests
(check-equal?
 (interp-a (new-state (list (Asetreg 0 1)
                            (Ahalt)))) 1)

(check-equal?
 (interp-a (new-state (list (Asetreg 1 1)
                            (Asetreg 2 2)
                            (Aadd)
                            (Ahalt)))) 3)

(check-equal?
 (interp-a (new-state (list (Asetreg 1 1)
                            (Asetreg 2 2)
                            (Amul)
                            (Ahalt)))) 2)

(check-equal?
 (interp-a (new-state (list (Asetreg 1 1) ; set reg[1] = 1
                            (Astore 1 3)  ; store reg[1] into heap[3]
                            (Aload 0 3)   ; load heap[3] into reg[0]
                            (Ahalt)))) 1)

; test dynamic load
(check-equal?
 (interp-a (new-state (list (Asetreg 1 3)      ; set reg[1] = 3
                            (Astore 1 3)       ; store reg[1] into heap[3]
                            (Adynamicload 0 1) ; set reg[0] = heap[reg[1]]
                            (Ahalt)))) 3)

(check-false (traps? (list (Asetreg 0 1)
                           (Atrap 1)
                           (Ahalt))))

(check-true (traps? (list (Asetreg 0 1)
                          (Atrap 2)
                          (Ahalt))))

(define (calc? e)
  (or (elet? e) (efst? e) (esnd? e) (epair? e) (enum? e) (eident? e)))

(struct elet (id assgn body) #:transparent
  #:guard (struct-guard/c string? calc? calc?))
(struct eident (id) #:transparent
  #:guard (struct-guard/c string?))
(struct efst (e) #:transparent
  #:guard (struct-guard/c calc?))
(struct esnd (e) #:transparent
  #:guard (struct-guard/c calc?))
(struct epair (e1 e2) #:transparent
  #:guard (struct-guard/c calc? calc?))
(struct enum (n) #:transparent
  #:guard (struct-guard/c number?))

;;; subst : calc -> string -> calc -> calc
;;; substitutes expr[id |-> e]
(define (subst expr id e)
  (match expr
    [(enum num) (enum num)]
    [(elet letid assignment body)
     (if (equal? letid id)
         (elet letid assignment body) ; shadowing case, do nothing
         (elet letid (subst assignment id e) (subst body id e))) ; not shadowing
     ]
    [(eident x)
     ;; if x = id, then we perform substitution. otherwise, do nothing
     (if (equal? id x) e (eident x))]
    [(epair e1 e2)
     (epair (subst e1 id e) (subst e2 id e))]
    [(efst e1) (efst (subst e1 id e))]
    [(esnd e1) (esnd (subst e1 id e))]))

;;; interp : calc -> calc
;;; runs a calculator expression
(define (interp-c expr)
  (match expr
    [(eident x) (error "runtime error: unbound identifier")]
    [(epair e1 e2)
     (epair (interp-c e1) (interp-c e2))]
    [(efst e1)
     (match (interp-c e1)
       [(epair fst _) fst]
       [_ (error  "runtime error: falling fst on nonpair")])]
    [(esnd e1)
     (match (interp-c e1)
       [(epair _ snd) snd]
       [_ (error  "runtime error: falling snd on nonpair")])]
    [(elet id binding body)
     (let* [(vbinding (interp-c binding))
            (substbody (subst body id vbinding))]
       (interp-c substbody))]
    [(enum n) (enum n)]))

(check-equal?
 (interp-c (elet "x" (epair (enum 10) (enum 20))
               (efst (eident "x"))))
 (enum 10))

(check-equal?
 (interp-c (elet "x"
               (epair (epair (enum 10) (enum 20)) (enum 30))
               (esnd (efst (eident "x")))))
 (enum 20))


;;; calc->asm : calc -> listof assembly
;;; your solution goes here. you should not edit anything else in this file (except for
;;; adding your own tests). You can add your own helper
(define (calc->asm c)
  (error 'implementme))

;;; compile-and-run : calc -> number
;;; compiles and runs a calculator program using our assembly interpreter
(define (compile-and-run c)
  (interp-a (new-state (calc->asm c))))