#lang plai (print-only-errors) (define-type KFAE [num (n number?)] [add (lhs KFAE?) (rhs KFAE?)] [sub (lhs KFAE?) (rhs KFAE?)] [id (name symbol?)] [fun (param-name symbol?) (body KFAE?)] [app (fun-expr KFAE?) (arg-expr KFAE?)] [ret-0] [ret (ret-expr KFAE?)]) (define-type KFAE-Value [numV (n number?)] [closureV (param-name symbol?) (body KFAE?) (ds DefSub?)]) (define-type DefSub [mtSub] [aSub (name symbol?) (value KFAE-Value?) (rest DefSub?)]) (define-type Cont [numop-do-right (rhs KFAE?) (ds DefSub?) (op (-> number? number? number?)) (rest-k Cont?)] [numop-do-op (l-val KFAE-Value?) (op (-> number? number? number?)) (rest-k Cont?)] [app-do-arg (arg-expr KFAE?) (ds DefSub?) (rest-k Cont?)] [app-do-body (fun-val KFAE-Value?) (rest-k Cont?)] [app-do-return (rest-k Cont?)] [do-early-return (rest-k Cont?)] [done]) ;; ---------------------------------------------------------------------- ;; parse : s-expression -> KFAE? (define (parse s-exp) (cond [(number? s-exp) (num s-exp)] [(symbol? s-exp) (id s-exp)] [(list? s-exp) (when (empty? s-exp) (error 'parse "the empty list is not a valid KFAE")) (case (first s-exp) [(+) (check-pieces s-exp "add" 3) (add (parse (second s-exp)) (parse (third s-exp)))] [(-) (check-pieces s-exp "sub" 3) (sub (parse (second s-exp)) (parse (third s-exp)))] [(fun) (check-pieces s-exp "fun" 3) (check-pieces (second s-exp) "parameter list" 1) (fun (first (second s-exp)) (parse (third s-exp)))] [(with) ; in lieu of a compiler (check-pieces s-exp "with" 3) (check-pieces (second s-exp) "with binding pair" 2) (app (fun (first (second s-exp)) (parse (third s-exp))) (parse (second (second s-exp))))] [(ret-0) (check-pieces s-exp "ret-0" 1) (ret-0)] [(ret) (check-pieces s-exp "ret" 2) (ret (parse (second s-exp)))] [else (check-pieces s-exp "app" 2) (app (parse (first s-exp)) (parse (second s-exp)))])] [else (error 'parse "wat")])) (define (check-pieces s-exp expected n-pieces) (unless (and (list? s-exp) (= n-pieces (length s-exp))) (error 'parse "expected ~a got ~a" expected s-exp))) ;; ---------------------------------------------------------------------- ;; interp-expr : s-expression -> KFAE-Value? (define (interp-expr s-exp) (interp (parse s-exp) (mtSub) (done))) ;; interp : KFAE? DefSub? Cont? -> KFAE-Value? (define (interp a-kfae ds k) (type-case KFAE a-kfae [num (n) (interp-cont (numV n) k)] [add (l r) (numop + l r ds k)] [sub (l r) (numop - l r ds k)] [id (name) (interp-cont (lookup name ds) k)] [fun (param-name body) (interp-cont (closureV param-name body ds) k)] [app (fun-expr arg-expr) (interp fun-expr ds (app-do-arg arg-expr ds k))] [ret-0 () 'bob] [ret (ret-expr) 'bob])) ;; interp-cont : KFAE-Value? Cont? -> KFAE-Value? (define (interp-cont v k) (type-case Cont k [done () v] [numop-do-right (r ds op rest-k) (define l-val v) (interp r ds (numop-do-op l-val op rest-k))] [numop-do-op (l-val op rest-k) (define r-val v) (unless (numV? l-val) (error 'interp "expected number")) (unless (numV? r-val) (error 'interp "expected number")) (interp-cont (numV (op (numV-n l-val) (numV-n r-val))) rest-k)] [app-do-arg (arg-expr ds rest-k) (define fun-val v) (interp arg-expr ds (app-do-body v rest-k))] [app-do-body (fun-val rest-k) (define arg-val v) (unless (closureV? fun-val) (error 'interp "expected function")) (interp (closureV-body fun-val) (aSub (closureV-param-name fun-val) arg-val (closureV-ds fun-val)) (app-do-return rest-k))] [app-do-return (rest-k) (interp-cont v rest-k)] [do-early-return (rest-k) 'bob])) ;; numop : (number? number? -> number?) KFAE? KFAE? DefSub? Cont? -> KFAE-Value? (define (numop op l r ds k) (interp l ds (numop-do-right r ds op k))) ;; lookup : symbol? DefSub? -> KFAE-Value? (define (lookup name ds) (type-case DefSub ds [mtSub () (error "free identifier")] [aSub (name2 value rest) (if (equal? name name2) value (lookup name rest))])) (test (interp-expr `{+ {{fun {x} {+ x {ret-0}}} 5} 3}) (numV 3)) (test/exn (interp-expr `{+ 3 {ret-0}}) "not inside a function call") (test (interp-expr `{with {f {fun {x} {+ x {ret-0}}}} {with {g {fun {y} {+ 5 {f y}}}} {+ 10 {g 18}}}}) (numV 15)) (test (interp-expr `{with {f {fun {x} {+ x {ret-0}}}} {with {g {fun {y} {+ {ret-0} {f y}}}} {+ 10 {g 18}}}}) (numV 10)) (test (interp-expr `{with {f {fun {x} {+ x {ret-0}}}} {with {g {fun {y} {+ {f y} {ret-0}}}} {+ 10 {g 18}}}}) (numV 10)) (test (interp-expr `{+ {{fun {x} {+ x {ret {+ 2 29}}}} 5} 3}) (numV 34)) (test/exn (interp-expr `{+ 3 {ret 2}}) "not inside a function call") (test (interp-expr `{with {f {fun {x} {+ x {ret 2}}}} {with {g {fun {y} {+ 5 {f y}}}} {+ 10 {g 18}}}}) (numV 17)) (test (interp-expr `{with {f {fun {x} {+ x {ret 100}}}} {with {g {fun {y} {+ {ret 200} {f y}}}} {+ 10 {g 18}}}}) (numV 210)) (test (interp-expr `{with {f {fun {x} {+ x {ret 50}}}} {with {g {fun {y} {+ {f y} {ret 70}}}} {+ 10 {g 18}}}}) (numV 80)) (test (interp-expr `{+ {{fun {x} {+ x {ret {+ 2 {ret 29}}}}} 5} 3}) (numV 32)) ;; ---------------------------------------------------------------------- ;; 5 (test (interp-expr `5) (numV 5)) ;; {+ 5 2} (test (interp-expr `{+ 5 2}) (numV 7)) ;; {{+ 3 4} + {- 2 5}} ;; WRONG ;; {- 3 {+ 4 5}} (test (interp-expr `{- 3 {+ 4 5}}) (numV -6)) ;; x (test/exn (interp-expr `x) "free identifier") ;; {with {x 3} x} (test (interp-expr `{with {x 3} x}) (numV 3)) (test (interp-expr `{with {x {+ 1 2}} x}) (numV 3)) (test (interp-expr `{with {x 3} {with {x 2} x}}) (numV 2)) (test (interp-expr `{with {y 3} {with {x 2} {+ x y}}}) (numV 5)) (test (interp-expr `{with {x {with {y 3} y}} {+ x 4}}) (numV 7)) (test (interp-expr `{with {x {with {x 3} x}} {+ x 4}}) (numV 7)) (test (interp-expr `{+ {with {x 2} x} {with {x 5} x}}) (numV 7)) (test (interp-expr `{with {f {fun {x} {+ 1 x}}} {f 3}}) (numV 4)) (test (interp-expr `{{fun {x} {+ x 1}} 3}) (numV 4)) (test/exn (interp-expr `{1 2}) "expected function") (test/exn (interp-expr `{+ 1 {fun {x} 10}}) "expected number") (test/exn (interp-expr `{with {f {fun {x} {+ x y}}} {with {y 2} {f y}}}) "free identifier") (test (interp-expr `{fun {x} {+ x 1}}) (closureV 'x (add (id 'x) (num 1)) (mtSub))) (test (interp-expr `{{with {y 2} {fun {x} {+ y x}}} 5}) (numV 7)) (test/exn (interp-expr `{{with {y 2} {fun {x} {+ x z}}} 5}) "free identifier") (test/exn (interp-expr `{with {f {fun {x} {+ x y}}} {with {y 10} {f 3}}}) "free identifier") ;; ---------------------------------------------------------------------- (test (interp-expr `{{fun {x} {+ x {ret-0}}} 5}) (numV 0)) (test (interp-expr `{+ {{fun {x} {+ x {ret-0}}} 5} 3}) (numV 3)) (test/exn (interp-expr `{ret-0}) "not inside a function") (test (interp-expr `{with {f {fun {x} {+ 3 {ret-0}}}} {with {g {fun {y} {+ 10 {f y}}}} {g 8}}}) (numV 10)) (test (interp-expr `{{fun {x} {+ x {ret 2}}} 5}) (numV 2)) (test (interp-expr `{+ {{fun {x} {+ x {ret 2}}} 5} 10}) (numV 12)) (test/exn (interp-expr `{ret 2}) "not inside a function") (test (interp-expr `{with {f {fun {x} {+ 3 {ret x}}}} {with {g {fun {y} {+ 10 {ret {f y}}}}} {g 8}}}) (numV 8))