#lang plait ;; ============================================================================= ;; Interpreter (Fall 2020): support.rkt ;; ============================================================================= ;; DO NOT EDIT THIS FILE ======================================================= (define-type-alias Env (Hashof Symbol Value)) (define-type Value (v-num [value : Number]) (v-str [value : String]) (v-bool [value : Boolean]) (v-fun [param : Symbol] [body : Expr] [env : Env])) (define-type Expr (e-num [value : Number]) (e-str [value : String]) (e-bool [value : Boolean]) (e-op [op : Operator] [left : Expr] [right : Expr]) (e-if [cond : Expr] [consq : Expr] [altern : Expr]) (e-lam [param : Symbol] [body : Expr]) (e-app [func : Expr] [arg : Expr]) (e-id [name : Symbol]) (sugar-and [left : Expr] [right : Expr]) (sugar-or [left : Expr] [right : Expr]) (sugar-let [id : Symbol] [value : Expr] [body : Expr])) (define-type Operator (op-plus) (op-append) (op-str-eq) (op-num-eq)) (define-type InterpError (err-if-got-non-boolean [val : Value]) (err-bad-arg-to-op [op : Operator] [val : Value]) (err-unbound-id [name : Symbol]) (err-not-a-function [val : Value])) (define-syntax-rule (~a arg ...) (foldl (lambda (val string) (string-append string val)) "" (list (to-string arg) ...))) (define (interp-error->string interp-error) (type-case InterpError interp-error [(err-if-got-non-boolean val) (~a "if got non boolean value " val)] [(err-bad-arg-to-op op val) (~a "operator " op " got bad arg " val)] [(err-unbound-id name) (~a name " is unbound")] [(err-not-a-function val) (~a val " is not a function")])) (define (raise-error [err : InterpError]) (error 'InterpError (interp-error->string err))) (define (parse [input : S-Exp]): Expr (cond [(s-exp-number? input) (e-num (s-exp->number input))] [(s-exp-string? input) (e-str (s-exp->string input))] [(s-exp-match? `true input) (e-bool #t)] [(s-exp-match? `false input) (e-bool #f)] [(s-exp-match? `{if ANY ...} input) (let ([inlst (s-exp->list input)]) (if (equal? (length inlst) 4) (e-if (parse (second inlst)) (parse (third inlst)) (parse (fourth inlst))) (error '+ "incorrect number of args to +")))] [(s-exp-match? `{and ANY ...} input) (let ([inlst (s-exp->list input)]) (if (equal? (length inlst) 3) (sugar-and (parse (second inlst)) (parse (third inlst))) (error '+ "incorrect number of args to and")))] [(s-exp-match? `{or ANY ...} input) (let ([inlst (s-exp->list input)]) (if (equal? (length inlst) 3) (sugar-or (parse (second inlst)) (parse (third inlst))) (error '+ "incorrect number of args to or")))] [(s-exp-match? `{+ ANY ...} input) (let ([inlst (s-exp->list input)]) (if (equal? (length inlst) 3) (e-op (op-plus) (parse (second inlst)) (parse (third inlst))) (error '+ "incorrect number of args to +")))] [(s-exp-match? `{++ ANY ...} input) (let ([inlst (s-exp->list input)]) (if (equal? (length inlst) 3) (e-op (op-append) (parse (second inlst)) (parse (third inlst))) (error '++ "incorrect number of args to ++")))] [(s-exp-match? `{num= ANY ...} input) (let ([inlst (s-exp->list input)]) (if (equal? (length inlst) 3) (e-op (op-num-eq) (parse (second inlst)) (parse (third inlst))) (error 'num= "incorrect number of args to num=")))] [(s-exp-match? `{str= ANY ...} input) (let ([inlst (s-exp->list input)]) (if (equal? (length inlst) 3) (e-op (op-str-eq) (parse (second inlst)) (parse (third inlst))) (error 'str= "incorrect number of args to str=")))] [(s-exp-match? `{lam SYMBOL ANY ...} input) (let ([inlst (s-exp->list input)]) (if (equal? (length inlst) 3) (e-lam (s-exp->symbol (second inlst)) (parse (third inlst))) (error 'lam "lambdas should only have one body")))] [(s-exp-match? `{lam ANY ...} input) (error 'lam "lambda parameters must be symbols")] [(s-exp-match? `{let {SYMBOL ANY} ANY ...} input) (let ([inlst (s-exp->list input)]) (if (equal? (length inlst) 3) (sugar-let (s-exp->symbol (first (s-exp->list (second inlst)))) (parse (second (s-exp->list (second inlst)))) (parse (third inlst))) (error 'let "incorrect number of args to let")))] [(s-exp-match? `{ANY ...} input) (let ([inlst (s-exp->list input)]) (if (equal? (length inlst) 2) (e-app (parse (first inlst)) (parse (second inlst))) (error 'app "incorrect number of args to app")))] [(s-exp-symbol? input) (e-id (s-exp->symbol input))]))