API tools faq
paste
Guest User

Homework 7 - parts 1 and 2

a guest
Apr 5th, 2024
144
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Racket 13.92 KB | None | 0 0
raw download clone embed print report
  1. #lang plait
  2.  
  3. (define-type Value
  4.   (numV [n : Number])
  5.   (closV [args : (Listof Symbol)]
  6.          [body : Exp]
  7.          [env : Env])
  8.   (contV [k : Cont]))
  9.  
  10. (define-type Exp
  11.   (numE [n : Number])
  12.   (idE [s : Symbol])
  13.   (plusE [l : Exp]
  14.          [r : Exp])
  15.   (multE [l : Exp]
  16.          [r : Exp])
  17.   (lamE [ns : (Listof Symbol)]
  18.         [body : Exp])
  19.   (appE [fun : Exp]
  20.         [args : (Listof Exp)])
  21.   (let/ccE [n : Symbol]
  22.            [body : Exp])
  23.   (negE [n : Exp])
  24.   (avgE [n1 : Exp]
  25.         [n2 : Exp]
  26.         [n3 : Exp])
  27.   (if0 [test : Exp]
  28.        [trueExp : Exp]
  29.        [falseExp : Exp]))
  30.  
  31. (define-type Binding
  32.   (bind [name : Symbol]
  33.         [val : Value]))
  34.  
  35. (define-type-alias Env (Listof Binding))
  36.  
  37. (define mt-env empty)
  38. (define extend-env cons)
  39. (define extend-env* append)
  40.  
  41.  
  42. (define-type Cont
  43.   (doneK)
  44.   (makeNegK    [k : Cont])
  45.   (doAvgK      [v1 : Value]
  46.                [v2 : Value]
  47.                [k : Cont])
  48.   (avgSecondK  [n2 : Exp]
  49.                [n3 : Exp]
  50.                [e : Env]
  51.                [k : Cont])
  52.   (avgThirdK   [n3 : Exp]
  53.                [v1 : Value]
  54.                [e : Env]
  55.                [k : Cont])
  56.   (ifSecondK   [trueExp : Exp]
  57.                [falseExp : Exp]
  58.                [e : Env]
  59.                [k : Cont])
  60.   (doPlusK     [v : Value]
  61.                [k : Cont])
  62.   (plusSecondK [r : Exp]
  63.                [e : Env]
  64.                [k : Cont])
  65.   (doMultK     [v : Value]
  66.                [k : Cont])
  67.   (multSecondK [r : Exp]
  68.                [e : Env]
  69.                [k : Cont])
  70.   (firstArgK   [args : (Listof Exp)]
  71.                [e : Env]
  72.                [k : Cont])
  73.   (appArgK     [args : (Listof Exp)]      
  74.                [vals : (Listof Value)]  
  75.                [closure : Value]        
  76.                [e : Env]                  
  77.                [k : Cont]))            
  78.  
  79.  
  80. (module+ test
  81.   (print-only-errors #t))
  82.  
  83. ;; parse ----------------------------------------
  84. (define (parse [s : S-Exp]) : Exp
  85.   (cond
  86.     [(s-exp-match? `NUMBER s) (numE (s-exp->number s))]
  87.     [(s-exp-match? `SYMBOL s) (idE (s-exp->symbol s))]
  88.     [(s-exp-match? `{+ ANY ANY} s)
  89.      (plusE (parse (second (s-exp->list s)))
  90.             (parse (third (s-exp->list s))))]
  91.     [(s-exp-match? `{* ANY ANY} s)
  92.      (multE (parse (second (s-exp->list s)))
  93.             (parse (third (s-exp->list s))))]
  94.     [(s-exp-match? `{neg ANY} s) (negE (parse (second (s-exp->list s))))]
  95.     [(s-exp-match? `{avg ANY ANY ANY} s)
  96.      (avgE (parse (second (s-exp->list s)))
  97.            (parse (third (s-exp->list s)))
  98.            (parse (fourth (s-exp->list s))))]
  99.     [(s-exp-match? `{if0 ANY ANY ANY} s)
  100.      (if0 (parse (second (s-exp->list s)))
  101.           (parse (third (s-exp->list s)))
  102.           (parse (fourth (s-exp->list s))))]
  103.    
  104.     [(s-exp-match? `{let {[SYMBOL ANY]} ANY} s)
  105.      (let ([bs (s-exp->list (first
  106.                              (s-exp->list (second
  107.                                            (s-exp->list s)))))])
  108.        (appE (lamE (list (s-exp->symbol (first bs)))
  109.                    (parse (third (s-exp->list s))))
  110.              (list (parse (second bs)))))]
  111.     [(s-exp-match? `{lambda {SYMBOL ...} ANY} s)
  112.      (lamE (map s-exp->symbol (s-exp->list
  113.                                (second (s-exp->list s))))
  114.            (parse (third (s-exp->list s))))]
  115.     [(s-exp-match? `{let/cc SYMBOL ANY} s)
  116.      (let/ccE (s-exp->symbol (second (s-exp->list s)))
  117.               (parse (third (s-exp->list s))))]
  118.     [(s-exp-match? `{ANY ANY ...} s)
  119.      (appE (parse (first (s-exp->list s)))
  120.            (map parse (rest (s-exp->list s))))]
  121.     [else (error 'parse "invalid input")]))
  122.  
  123. (module+ test
  124.   (test (parse `2)
  125.         (numE 2))
  126.   (test (parse `x) ; note: backquote instead of normal quote
  127.         (idE 'x))
  128.   (test (parse `{+ 2 1})
  129.         (plusE (numE 2) (numE 1)))
  130.   (test (parse `{* 3 4})
  131.         (multE (numE 3) (numE 4)))
  132.   (test (parse `{+ {* 3 4} 8})
  133.         (plusE (multE (numE 3) (numE 4))
  134.                (numE 8)))
  135.   (test (parse `{let {[x {+ 1 2}]}
  136.                   y})
  137.         (appE (lamE (list 'x) (idE 'y))
  138.               (list (plusE (numE 1) (numE 2)))))
  139.   (test (parse `{lambda {x} 9})
  140.         (lamE (list 'x) (numE 9)))
  141.   (test (parse `{let/cc k 0})
  142.         (let/ccE 'k (numE 0)))
  143.   (test (parse `{double 9})
  144.         (appE (idE 'double) (list (numE 9))))
  145.   (test/exn (parse `{})
  146.             "invalid input"))
  147.  
  148. ;; interp & continue ----------------------------------------
  149. (define (interp [a : Exp] [env : Env] [k : Cont]) : Value
  150.   (type-case Exp a
  151.     [(numE n) (continue k (numV n))]
  152.     [(idE s) (continue k (lookup s env))]
  153.     [(plusE l r) (interp l env
  154.                          (plusSecondK r env k))]
  155.     [(multE l r) (interp l env
  156.                          (multSecondK r env k))]
  157.     [(negE n) (interp n env (makeNegK k))]
  158.     [(avgE n1 n2 n3) (interp n1 env (avgSecondK n2 n3 env k))]
  159.     [(if0 testExp trueExp falseExp) (interp testExp env (ifSecondK trueExp falseExp env k))]
  160.     [(lamE ns body)
  161.      (continue k (closV ns body env))]
  162.     [(appE fun args) (interp fun env
  163.                              (firstArgK args env k))]
  164.     [(let/ccE n body)
  165.      (interp body
  166.              (extend-env (bind n (contV k))
  167.                          env)
  168.              k)]))
  169.  
  170. ;; interp-expr -------------------------------------
  171. (define (interp-expr [e : Exp]) : S-Exp
  172.   (let ([val (interp e mt-env (doneK))])
  173.     (type-case Value val
  174.       [(numV n) (number->s-exp n)]
  175.       [(closV arg body env) `function]
  176.       [(contV k) `function])))
  177.  
  178. ;; continue -----------------------------------------
  179. (define (continue [k : Cont] [v : Value]) : Value
  180.   (type-case Cont k
  181.     [(doneK) v]
  182.     [(makeNegK next-k)
  183.      (type-case Value v
  184.        [(numV n) (continue next-k (numV (* -1 n)))]
  185.        [else (error 'interp "neg NaN")])]
  186.     [(avgSecondK n2 n3 env next-k)
  187.      (interp n2 env (avgThirdK n3 v env next-k))]
  188.     [(avgThirdK n3 v1 env next-k)
  189.      (interp n3 env (doAvgK v v1 next-k))]
  190.     [(doAvgK v1 v2 next-k)
  191.      (continue next-k (avg-helper v v1 v2))]
  192.     [(ifSecondK pass fail env next-k)
  193.      (type-case Value v
  194.        [(numV n)
  195.         (if (= 0 n)
  196.             (interp pass env next-k)
  197.             (interp fail env next-k))]            
  198.        [else (error 'interp "if0 NaN")])]
  199.     [(plusSecondK r env next-k)
  200.      (interp r env
  201.              (doPlusK v next-k))]
  202.     [(doPlusK v-l next-k)
  203.      (continue next-k (num+ v-l v))]
  204.     [(multSecondK r env next-k)
  205.      (interp r env
  206.              (doMultK v next-k))]
  207.     [(doMultK v-l next-k)
  208.      (continue next-k (num* v-l v))]
  209.     [(firstArgK args env next-k)
  210.      (type-case (Listof Exp) args
  211.        [empty (type-case Value v
  212.                 [(closV ns body c-env)
  213.                  (interp body c-env next-k)]
  214.                 [(contV k-v) (error 'interp "cannot call contV with zero arguments")]
  215.                 [else (error 'interp "not a function")])]
  216.        [(cons fst rst)
  217.         (interp fst env (appArgK rst empty v env next-k))])]
  218.     [(appArgK args vals closure env next-k)
  219.      (type-case (Listof Exp) args
  220.        [empty (type-case Value closure
  221.                 [(closV ns body c-env)
  222.                  (interp body
  223.                          (extend-env*
  224.                           (map2 bind ns (reverse (cons v vals)))
  225.                           c-env)
  226.                          next-k)]
  227.                 [(contV k-v)
  228.                  (if (zero? (- 1 (length (cons v vals))))
  229.                      (continue k-v v)
  230.                      (error 'interp "cannot call contV with more than one argument"))]
  231.                 [else (error 'interp "not a function")])]
  232.        [(cons fst rst)
  233.         (interp fst env (appArgK rst (cons v vals) closure env next-k))])]))
  234.  
  235.  
  236. (module+ test
  237.   (test (avg-helper (numV 1) (numV 2) (numV 3))
  238.         (numV 2))
  239.   (test/exn (avg-helper (closV (list 'x) (idE 'x) mt-env) (numV 2) (numV 3))
  240.             "avg NaN")
  241.   (test/exn (avg-helper (numV 2) (closV (list 'x) (idE 'x) mt-env) (numV 3))
  242.             "avg NaN")
  243.   (test/exn (avg-helper (numV 2) (numV 3) (closV (list 'x) (idE 'x) mt-env))
  244.             "avg NaN"))
  245.  
  246. (define (avg-helper [v1 : Value] [v2 : Value] [v3 : Value]) : Value
  247.   (type-case Value v1
  248.     [(numV n1)
  249.      (type-case Value v2
  250.        [(numV n2)
  251.         (type-case Value v3
  252.           [(numV n3) (numV (/ (+ n1 (+ n2 n3)) 3))]
  253.           [else (error 'interp "avg NaN")])]
  254.        [else (error 'interp "avg NaN")])]
  255.     [else (error 'interp "avg NaN")]))
  256.  
  257.  
  258.  
  259.  
  260. (module+ test
  261.  
  262.   (test (interp-expr (parse `{neg 2}))
  263.         `-2)
  264.   (test (interp-expr (parse `{neg {+ -3 -4}}))
  265.         `7)
  266.   (test (interp-expr (parse `{let/cc k {neg {k 3}}}))
  267.         `3)
  268.   (test/exn (interp-expr (parse `{neg {lambda {x} x}}))
  269.             "neg NaN")
  270.  
  271.   (test (interp-expr (parse `{avg 0 6 6}))
  272.         `4)
  273.   (test (interp-expr (parse `{let/cc k {avg 0 {k 3} 0}}))
  274.         `3)
  275.   (test (interp-expr (parse `{let/cc k {avg {k 2} {k 3} 0}}))
  276.         `2)
  277.  
  278.   (test (interp-expr (parse `{if0 1 2 3}))
  279.         `3)
  280.   (test/exn (interp-expr (parse `{if0 {lambda {x} x} 2 3}))
  281.             "if0 NaN")
  282.   (test (interp-expr (parse `{if0 0 2 3}))
  283.         `2)
  284.   (test (interp-expr (parse `{let/cc k {if0 {k 9} 2 3}}))
  285.         `9)
  286.  
  287.   (test (interp-expr (parse `{{lambda {x y} {+ y {neg x}}} 10 12}))
  288.         `2)
  289.   (test (interp-expr (parse `{lambda {} 12}))
  290.         `function)
  291.   (test (interp-expr (parse `{lambda {x} {lambda {} x}}))
  292.         `function)
  293.   (test (interp-expr (parse `{{{lambda {x} {lambda {} x}} 13}}))
  294.         `13)
  295.  
  296.   (test (interp-expr (parse `{let/cc esc {{lambda {x y} x} 1 {esc 3}}}))
  297.         `3)
  298.   (test (interp-expr (parse `{{let/cc esc {{lambda {x y} {lambda {z} {+ z y}}}
  299.                                            1
  300.                                            {let/cc k {esc k}}}}
  301.                               10}))
  302.         `20)
  303.  
  304.  
  305.   (test/exn (continue (firstArgK empty mt-env (doneK)) (numV 7))
  306.             "not a function")
  307.   (test (interp-expr (parse `{lambda {x} {+ x x}}))
  308.         `function)
  309.   (test (interp-expr (parse ` {let/cc k k}))
  310.         `function)
  311.   (test (interp-expr (parse `{lambda {x} {lambda {} x}}))
  312.         `function)
  313.  
  314.   (test (interp (parse `2) mt-env (doneK))
  315.         (numV 2))
  316.   (test/exn (interp (parse `x) mt-env (doneK))
  317.             "free variable")
  318.   (test (interp (parse `x)
  319.                 (extend-env (bind 'x (numV 9)) mt-env)
  320.                 (doneK))
  321.         (numV 9))
  322.   (test (interp (parse `{+ 2 1}) mt-env (doneK))
  323.         (numV 3))
  324.   (test (interp (parse `{* 2 1}) mt-env (doneK))
  325.         (numV 2))
  326.   (test (interp (parse `{+ {* 2 3} {+ 5 8}})
  327.                 mt-env
  328.                 (doneK))
  329.         (numV 19))
  330.   (test (interp (parse `{lambda {x} {+ x x}})
  331.                 mt-env
  332.                 (doneK))
  333.         (closV (list 'x) (plusE (idE 'x) (idE 'x)) mt-env))
  334.   (test (interp (parse `{let {[x 5]}
  335.                           {+ x x}})
  336.                 mt-env
  337.                 (doneK))
  338.         (numV 10))
  339.   (test (interp (parse `{let {[x 5]}
  340.                           {let {[x {+ 1 x}]}
  341.                             {+ x x}}})
  342.                 mt-env
  343.                 (doneK))
  344.         (numV 12))
  345.   (test (interp (parse `{let {[x 5]}
  346.                           {let {[y 6]}
  347.                             x}})
  348.                 mt-env
  349.                 (doneK))
  350.         (numV 5))
  351.   (test (interp (parse `{{lambda {x} {+ x x}} 8})
  352.                 mt-env
  353.                 (doneK))
  354.         (numV 16))
  355.  
  356.   (test (interp (parse `{let/cc k {+ 1 {k 0}}})
  357.                 mt-env
  358.                 (doneK))
  359.         (numV 0))
  360.   (test (interp (parse `{let {[f {let/cc k k}]}
  361.                           {f {lambda {x} 10}}})
  362.                 mt-env
  363.                 (doneK))
  364.         (numV 10))
  365.  
  366.   (test/exn (interp (parse `{1 2}) mt-env (doneK))
  367.             "not a function")
  368.   (test/exn (interp (parse `{+ 1 {lambda {x} x}}) mt-env (doneK))
  369.             "not a number")
  370.   (test/exn (interp (parse `{let {[bad {lambda {x} {+ x y}}]}
  371.                               {let {[y 5]}
  372.                                 {bad 2}}})
  373.                     mt-env
  374.                     (doneK))
  375.             "free variable")
  376.  
  377.   (test/exn (interp (parse `{{lambda {x} 0} {1 2}}) mt-env (doneK))
  378.             "not a function")
  379.  
  380.   (test (continue (doneK) (numV 5))
  381.         (numV 5))
  382.   (test (continue (plusSecondK (numE 6) mt-env (doneK)) (numV 5))
  383.         (numV 11))
  384.   (test (continue (doPlusK (numV 7) (doneK)) (numV 5))
  385.         (numV 12))
  386.   (test (continue (multSecondK (numE 6) mt-env (doneK)) (numV 5))
  387.         (numV 30))
  388.   (test (continue (doMultK (numV 7) (doneK)) (numV 5))
  389.         (numV 35)))
  390.  
  391.  
  392. ;; num+ and num* ----------------------------------------
  393. (define (num-op [op : (Number Number -> Number)] [l : Value] [r : Value]) : Value
  394.   (cond
  395.     [(and (numV? l) (numV? r))
  396.      (numV (op (numV-n l) (numV-n r)))]
  397.     [else
  398.      (error 'interp "not a number")]))
  399. (define (num+ [l : Value] [r : Value]) : Value
  400.   (num-op + l r))
  401. (define (num* [l : Value] [r : Value]) : Value
  402.   (num-op * l r))
  403.  
  404. (module+ test
  405.   (test (num+ (numV 1) (numV 2))
  406.         (numV 3))
  407.   (test (num* (numV 2) (numV 3))
  408.         (numV 6)))
  409.  
  410. ;; lookup ----------------------------------------
  411. (define (lookup [n : Symbol] [env : Env]) : Value
  412.   (type-case (Listof Binding) env
  413.     [empty (error 'lookup "free variable")]
  414.     [(cons b rst-env) (cond
  415.                         [(symbol=? n (bind-name b))
  416.                          (bind-val b)]
  417.                         [else (lookup n rst-env)])]))
  418.  
  419. (module+ test
  420.   (test/exn (lookup 'x mt-env)
  421.             "free variable")
  422.   (test (lookup 'x (extend-env (bind 'x (numV 8)) mt-env))
  423.         (numV 8))
  424.   (test (lookup 'x (extend-env
  425.                     (bind 'x (numV 9))
  426.                     (extend-env (bind 'x (numV 8)) mt-env)))
  427.         (numV 9))
  428.   (test (lookup 'y (extend-env
  429.                     (bind 'x (numV 9))
  430.                     (extend-env (bind 'y (numV 8)) mt-env)))
  431.         (numV 8)))
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!