Skip to content

Instantly share code, notes, and snippets.

@wolverian
Created October 8, 2014 20:24
Show Gist options
  • Save wolverian/b676a6c068d4bea2aa0c to your computer and use it in GitHub Desktop.
Save wolverian/b676a6c068d4bea2aa0c to your computer and use it in GitHub Desktop.

Revisions

  1. wolverian created this gist Oct 8, 2014.
    30 changes: 30 additions & 0 deletions plai-typed-racket.rkt
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,30 @@
    (: interp (Expr-C Env Store -> Result))
    (define (interp expr env store)
    (match expr
    [(num-c n) (v*s (num-v n) store)]
    [(plus-c l r) (match-let* ([(v*s v-l s-l) (interp l env store)]
    [(v*s v-r s-r) (interp r env s-l)])
    (v*s (num+ v-l v-r) s-r))]
    [(mult-c l r) (match-let* ([(v*s v-l s-l) (interp l env store)]
    [(v*s v-r s-r) (interp r env s-l)])
    (v*s (num* v-l v-r) s-r))]
    [(app-c f arg-val) (match-let* ([(v*s (clos-v a b f-e) f-s) (interp f env store)]
    [(v*s a-v a-s) (interp arg-val env f-s)]
    [where (new-loc)])
    (interp b
    (extend-env (bind a where) f-e)
    (override-store (cell where a-v) a-s)))]
    [(id-c n) (v*s (fetch (lookup n env) store) store)]
    [(lam-c arg body) (v*s (clos-v arg body env) store)]
    [(box-c a) (match-let ([(v*s v s) (interp a env store)])
    (let ([where (new-loc)])
    (v*s (box-v where)
    (override-store (cell where v)
    s))))]
    [(unbox-c a) (match-let ([(v*s (box-v loc) s) (interp a env store)])
    (v*s (fetch loc s) s))]
    [(set-box-c b v) (match-let* ([(v*s (box-v loc) s-b) (interp b env store)]
    [(v*s v-v s-v) (interp v env s-b)])
    (v*s v-v (override-store (cell loc v-v) s-v)))]
    [(seq-c a b) (match-let ([(v*s v s) (interp a env store)])
    (interp b env s))]))