diff --git a/Tests/02.rkt b/Tests/02.rkt new file mode 100644 index 0000000..6a8c10e --- /dev/null +++ b/Tests/02.rkt @@ -0,0 +1,93 @@ +#lang plait +(define-type IFLANG + [Num (val : Number)] + [Add (l : IFLANG) (r : IFLANG)] + [Div (l : IFLANG) (r : IFLANG)] + [Id (name : Symbol)] + [Let1 (id : Symbol) (named-expr : IFLANG) (bound-body : IFLANG)] + [Lam (param : Symbol) (body : IFLANG)] + [ILam (param : Symbol) (zero-body : IFLANG) (non-zero-body : IFLANG)] + [Call (fun : IFLANG) (val : IFLANG)]) ; first type! +(define-type ENV + [EmptyEnv] + [Extend (name : Symbol) (val : VAL) (rest : ENV)]) + +(define-type VAL + [NumV (n : Number)] + [LamV (arg : Symbol) (body : IFLANG) (env : ENV)] + [ILamV (arg : Symbol) (zero-body : IFLANG) (non-zero-body : IFLANG) (env : ENV)]) + +(define (lookup name env) + (type-case ENV env + [(EmptyEnv) (error 'lookup "missing binding")] + [(Extend id val rest-env) + (if (eq? id name) + val + (lookup name rest-env))])) + +(define (arith-op op val1 val2) (NumV (op (NumV-n val1) (NumV-n val2)))) +;; evaluates IFLANG expressions by reducing them to values +(define (interp expr env) + (type-case IFLANG expr + [(Num n) (NumV n)] + [(Add l r) (arith-op + (interp l env) + (interp r env))] + [(Div l r) (arith-op / (interp l env) (interp r env))] + [(Let1 bound-id named-expr bound-body) + (interp bound-body + (Extend bound-id (interp named-expr env) env))] + [(Id name) (lookup name env)] + [(ILam bound-id zero-body non-zero-body) + ; I thought this might delay the lookup so it would be bound by this point + (LamV bound-id (type-case VAL (lookup bound-id env) + [(NumV n) (if (equal? n 0) zero-body non-zero-body)] + [else (error 'ILam "not a number in ILam expression")]) env) + ; I got confused by why the arguments in the environment for a function are not bound to the identifier in the + ; lambda + #;(type-case VAL (lookup bound-id env) + [(NumV n) (if (equal? n 0) + (LamV bound-id zero-body env) + (LamV bound-id non-zero-body env))] + [else (error 'ILam "not a number in ILam expression")]) + ] + [(Lam bound-id bound-body) + (LamV bound-id bound-body env)] + [(Call lam-expr arg-expr) + (let ([fval (interp lam-expr env)]) + (type-case VAL fval + [(LamV bound-id bound-body f-env) + (interp bound-body + (Extend bound-id (interp arg-expr env) f-env))] + [else (error 'eval "expects function")]))])) +(define (run iflang) (NumV-n (interp iflang (EmptyEnv)))) + +(print-only-errors #t) + +(test (run + (Let1 'x (Num 3) + (Let1 'f (ILam 'y (Num -1) (Add (Id 'x) (Id 'y))) + (Let1 'x (Num 5) (Call (Id 'f) (Num 4)))))) + 7) + +(test (run + (Call (Let1 'x (Num 3) (ILam 'y (Num -1) (Add (Id 'x) (Id 'y)))) (Num 4))) + 7) + +(test (run + (Call + (Call + (Lam 'x (Call (Id 'x) (Num 1))) + (Lam 'x (ILam 'y (Num -1) (Add (Id 'x) (Id 'y))))) + (Num 123))) + 124) + +(test (run + (Let1 'f (ILam 'x (Id 'x) (Div (Num 1) (Id 'x))) + (Add (Call (Id 'f) (Num 3)) (Call (Id 'f) (Num 0))))) + 1/3) + +(test (run + (Let1 'x (Num 3) + (Let1 'f (ILam 'y (Id 'x) (Div (Id 'x) (Id 'y))) + (Let1 'x (Num 5) (Add (Call (Id 'f) (Num 3)) (Call (Id 'f) (Num 0))))))) + 4)