diff --git a/09-tidbit/main.rkt b/09-tidbit/main.rkt index 7056d1f..67d38bd 100644 --- a/09-tidbit/main.rkt +++ b/09-tidbit/main.rkt @@ -9,8 +9,12 @@ The grammar: | { / } | { with { } } | - | { fun { } } + | { fun } | { call } + | { of } + | { fun { ... } } + | { call { ...} } + | { of { ...} } |# (define-type TIDBIT @@ -21,8 +25,8 @@ The grammar: [Div TIDBIT TIDBIT] [Id Symbol] [With Symbol TIDBIT TIDBIT] - [Fun Symbol TIDBIT] - [Call TIDBIT TIDBIT]) + [Fun (Listof Symbol) TIDBIT] + [Call TIDBIT (Listof TIDBIT)]) (define-type Idx = Integer) @@ -33,7 +37,6 @@ The grammar: [CMul CORE CORE] [CDiv CORE CORE] [CIdx Idx] - [CWith CORE CORE] [CFun CORE] [CCall CORE CORE]) @@ -46,6 +49,19 @@ The grammar: (define (binding-encountered bd id) (lambda ([s : Symbol]) (if (symbol=? s id) 1 (add1 (bd s))))) +(: currycall : TIDBIT (Listof TIDBIT) BINDING-DEPTH -> CORE) +(define (currycall body args bd) + (match args + ['() (preprocess body bd)] + [else (CCall (currycall body (rest args) bd) (preprocess (first args) bd))])) + +(: curryfn : (Listof Symbol) TIDBIT BINDING-DEPTH -> CORE) +(define (curryfn params body bd) + (match params + ['() (preprocess body bd)] + [else (CFun (curryfn (rest params) body (binding-encountered bd (first params))))])) + + (: preprocess : TIDBIT BINDING-DEPTH -> CORE) (define (preprocess tb bd) (cases tb @@ -55,10 +71,10 @@ The grammar: [(Mul l r) (CMul (preprocess l bd) (preprocess r bd))] [(Div l r) (CDiv (preprocess l bd) (preprocess r bd))] [(Id s) (CIdx (bd s))] - [(With name value body) (CWith (preprocess value bd) - (preprocess body (binding-encountered bd name)))] - [(Fun param body) (CFun (preprocess body (binding-encountered bd param)))] - [(Call fn arg) (CCall (preprocess fn bd) (preprocess arg bd))])) + [(With name value body) (CCall (CFun (preprocess body (binding-encountered bd name))) + (preprocess value bd))] + [(Fun params body) (curryfn params body bd)] + [(Call body args) (currycall body args bd)])) (: parse-sexpr : Sexpr -> TIDBIT) ; Parses Sexprs into TIDBITs. @@ -73,14 +89,17 @@ The grammar: [else (error 'parse-sexpr "bad `with' syntax in ~s" sexpr)])] [(cons 'fun more) (match sexpr - [(list 'fun (list (symbol: name)) body) (Fun name (parse-sexpr body))] + [(list 'fun (symbol: param) body) (Fun (list param) (parse-sexpr body))] + [(list 'fun (list (symbol: params) ...) body) (Fun params (parse-sexpr body))] [else (error 'parse-sexpr "bad `fun' syntax in ~s" sexpr)])] [(list '+ lhs rhs) (Add (parse-sexpr lhs) (parse-sexpr rhs))] [(list '- lhs rhs) (Sub (parse-sexpr lhs) (parse-sexpr rhs))] [(list '* lhs rhs) (Mul (parse-sexpr lhs) (parse-sexpr rhs))] [(list '/ lhs rhs) (Div (parse-sexpr lhs) (parse-sexpr rhs))] - [(list 'call fun arg) (Call (parse-sexpr fun) (parse-sexpr arg))] - [(list fun 'of arg) (Call (parse-sexpr fun) (parse-sexpr arg))] + [(list 'call fun arg) (Call (parse-sexpr fun) (list (parse-sexpr arg)))] + [(list fun 'of arg) (Call (parse-sexpr fun) (list (parse-sexpr arg)))] + [(list 'call fun args ...) (Call (parse-sexpr fun) (map parse-sexpr args))] + [(list fun 'of args ...) (Call (parse-sexpr fun) (map parse-sexpr args))] [else (error 'parse-sexpr "bad syntax in ~s" sexpr)])) (: parse : String -> TIDBIT) @@ -117,8 +136,6 @@ The grammar: [(CSub l r) (arith-op - (eval l env) (eval r env))] [(CMul l r) (arith-op * (eval l env) (eval r env))] [(CDiv l r) (arith-op / (eval l env) (eval r env))] - [(CWith bound-val bound-body) - (eval bound-body (cons (eval bound-val env) env))] [(CIdx n) (list-ref env (sub1 n))] [(CFun body) (FunV body env)] @@ -139,6 +156,8 @@ The grammar: [else (error 'run "evaluation returned a non-number: ~s" result)]))) +(test (run "{{fun {x y z} {+ x {+ y z}}} of 1 2 3}") => 6) + (test (run "{{fun {x} {+ x 1}} of 4}") => 5) (test (run "{with {add3 {fun {x} {+ x 3}}}