API tools faq
paste
Advertisement
Guest User

Homewrk problems 1) and 2)

a guest
Mar 8th, 2024
243
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Racket 13.53 KB | None | 0 0
raw download clone embed print report
  1. #lang plait
  2.  
  3. (define-type-alias Location Number)
  4.  
  5. (define-type Value
  6.   (numV [n : Number])
  7.   (closV [arg : Symbol]
  8.          [body : Exp]
  9.          [env : Env])
  10.   (boxV [l : Location]))
  11.  
  12. (define-type Exp
  13.   (numE [n : Number])
  14.   (idE [s : Symbol])
  15.   (plusE [l : Exp]
  16.          [r : Exp])
  17.   (multE [l : Exp]
  18.          [r : Exp])
  19.   (letE [n : Symbol]
  20.         [rhs : Exp]
  21.         [body : Exp])
  22.   (lamE [n : Symbol]
  23.         [body : Exp])
  24.   (appE [fun : Exp]
  25.         [arg : Exp])
  26.   (boxE [arg : Exp])
  27.   (unboxE [arg : Exp])
  28.   (setboxE [bx : Exp]
  29.            [val : Exp])
  30.   ; definition of beginE changed to allow multiple expressions in begin form:
  31.   (beginE [lofExprs : (Listof Exp)]))
  32.  
  33. (define-type Binding
  34.   (bind [name : Symbol]
  35.         [val : Value]))
  36.  
  37. (define-type-alias Env (Listof Binding))
  38.  
  39. (define mt-env empty)
  40. (define extend-env cons)
  41.  
  42. (define-type Storage
  43.   (cell [location : Location]
  44.         [val : Value]))
  45.  
  46. (define-type-alias Store (Listof Storage))
  47. (define mt-store empty)
  48.  
  49.  
  50. ;(define override-store cons)
  51.  
  52. ; definition for override-store has changed acording to problem 1 requirement:
  53. (define (override-store [c : Storage] [s : Store]) : Store
  54.   (type-case Storage c
  55.     [(cell l v)
  56.      (type-case Store s
  57.        [empty
  58.         (cons c s)]
  59.        [(cons st rs)
  60.         (type-case Storage st
  61.           [(cell stl stv)
  62.            (if (= l stl)
  63.                (cons c rs)
  64.                (cons st (override-store c rs)))])])]))
  65.  
  66.  
  67. (define-type Result
  68.   (v*s [v : Value] [s : Store]))
  69.  
  70. (module+ test
  71.   (print-only-errors #t))
  72.  
  73. ;; parse ----------------------------------------
  74. (define (parse [s : S-Exp]) : Exp
  75.   (cond
  76.     [(s-exp-match? `NUMBER s) (numE (s-exp->number s))]
  77.     [(s-exp-match? `SYMBOL s) (idE (s-exp->symbol s))]
  78.     [(s-exp-match? `{+ ANY ANY} s)
  79.      (plusE (parse (second (s-exp->list s)))
  80.             (parse (third (s-exp->list s))))]
  81.     [(s-exp-match? `{* ANY ANY} s)
  82.      (multE (parse (second (s-exp->list s)))
  83.             (parse (third (s-exp->list s))))]
  84.     [(s-exp-match? `{let {[SYMBOL ANY]} ANY} s)
  85.      (let ([bs (s-exp->list (first
  86.                              (s-exp->list (second
  87.                                            (s-exp->list s)))))])
  88.        (letE (s-exp->symbol (first bs))
  89.              (parse (second bs))
  90.              (parse (third (s-exp->list s)))))]
  91.     [(s-exp-match? `{lambda {SYMBOL} ANY} s)
  92.      (lamE (s-exp->symbol (first (s-exp->list
  93.                                   (second (s-exp->list s)))))
  94.            (parse (third (s-exp->list s))))]
  95.     [(s-exp-match? `{box ANY} s)
  96.      (boxE (parse (second (s-exp->list s))))]
  97.     [(s-exp-match? `{unbox ANY} s)
  98.      (unboxE (parse (second (s-exp->list s))))]
  99.     [(s-exp-match? `{set-box! ANY ANY} s)
  100.      (setboxE (parse (second (s-exp->list s)))
  101.               (parse (third (s-exp->list s))))]
  102.     ; parsing for beginE has changed:
  103.     [(s-exp-match? `{begin ANY ANY ...} s)
  104.      (beginE (cons (parse (second (s-exp->list s)))
  105.                    (map parse (rest (rest (s-exp->list s))))))]
  106.     [(s-exp-match? `{ANY ANY} s)
  107.      (appE (parse (first (s-exp->list s)))
  108.            (parse (second (s-exp->list s))))]
  109.     [else (error 'parse "invalid input")]))
  110.  
  111. (module+ test
  112.   (test (parse `2)
  113.         (numE 2))
  114.   (test (parse `x)
  115.         (idE 'x))
  116.   (test (parse `{+ 2 1})
  117.         (plusE (numE 2) (numE 1)))
  118.   (test (parse `{* 3 4})
  119.         (multE (numE 3) (numE 4)))
  120.   (test (parse `{+ {* 3 4} 8})
  121.         (plusE (multE (numE 3) (numE 4))
  122.                (numE 8)))
  123.   (test (parse `{let {[x {+ 1 2}]}
  124.                   y})
  125.         (letE 'x (plusE (numE 1) (numE 2))
  126.               (idE 'y)))
  127.   (test (parse `{lambda {x} 9})
  128.         (lamE 'x (numE 9)))
  129.   (test (parse `{double 9})
  130.         (appE (idE 'double) (numE 9)))
  131.   (test (parse `{box 0})
  132.         (boxE (numE 0)))
  133.   (test (parse `{unbox b})
  134.         (unboxE (idE 'b)))
  135.   (test (parse `{set-box! b 0})
  136.         (setboxE (idE 'b) (numE 0)))
  137.   (test (parse `{begin 1 2})
  138.         (beginE (list (numE 1) (numE 2))))
  139.   (test/exn (parse `{{+ 1 2}})
  140.             "invalid input"))
  141.  
  142. ;; with form ----------------------------------------
  143. (define-syntax-rule
  144.   (with [(v-id sto-id) call]
  145.     body)
  146.   (type-case Result call
  147.     [(v*s v-id sto-id) body]))
  148.                                
  149. ;; interp ----------------------------------------
  150. (define (interp [a : Exp] [env : Env] [sto : Store]) : Result
  151.   (type-case Exp a
  152.     [(numE n) (v*s (numV n) sto)]
  153.     [(idE s) (v*s (lookup s env) sto)]
  154.     [(plusE l r)
  155.      (with [(v-l sto-l) (interp l env sto)]
  156.        (with [(v-r sto-r) (interp r env sto-l)]
  157.          (v*s (num+ v-l v-r) sto-r)))]
  158.     [(multE l r)
  159.      (with [(v-l sto-l) (interp l env sto)]
  160.        (with [(v-r sto-r) (interp r env sto-l)]
  161.          (v*s (num* v-l v-r) sto-r)))]
  162.     [(letE n rhs body)
  163.      (with [(v-rhs sto-rhs) (interp rhs env sto)]
  164.        (interp body
  165.                (extend-env
  166.                 (bind n v-rhs)
  167.                 env)
  168.                sto-rhs))]
  169.     [(lamE n body)
  170.      (v*s (closV n body env) sto)]
  171.     [(appE fun arg)
  172.      (with [(v-f sto-f) (interp fun env sto)]
  173.        (with [(v-a sto-a) (interp arg env sto-f)]
  174.          (type-case Value v-f
  175.            [(closV n body c-env)
  176.             (interp body
  177.                     (extend-env
  178.                      (bind n v-a)
  179.                      c-env)
  180.                     sto-a)]
  181.            [else (error 'interp "not a function")])))]
  182.     [(boxE a)
  183.      (with [(v sto-v) (interp a env sto)]
  184.        (let ([l (new-loc sto-v)])
  185.          (v*s (boxV l)
  186.               (override-store (cell l v)
  187.                               sto-v))))]
  188.     [(unboxE a)
  189.      (with [(v sto-v) (interp a env sto)]
  190.        (type-case Value v
  191.          [(boxV l) (v*s (fetch l sto-v)
  192.                         sto-v)]
  193.          [else (error 'interp "not a box")]))]
  194.     [(setboxE bx val)
  195.      (with [(v-b sto-b) (interp bx env sto)]
  196.        (with [(v-v sto-v) (interp val env sto-b)]
  197.          (type-case Value v-b
  198.            [(boxV l)
  199.             (v*s v-v
  200.                  (override-store (cell l v-v)
  201.                                  sto-v))]
  202.            [else (error 'interp "not a box")])))]
  203.     ; definition for beginE changed:
  204.     [(beginE lexpr)
  205.      (iterp-lexp lexpr env sto)]))
  206.  
  207. ; this function is added to accomodate for evaluating multiple expressions in begin form:
  208. (define (iterp-lexp [lexpr : (Listof Exp)] [env : Env] [sto : Store]) : Result
  209.   (if (empty? (rest lexpr))
  210.       (interp (first lexpr) env sto)
  211.       (with [(v-l sto-l) (interp (first lexpr) env sto)]
  212.             (iterp-lexp (rest lexpr) env sto-l))))
  213.  
  214.  
  215. (module+ test
  216.   (test (interp (parse `2) mt-env mt-store)
  217.         (v*s (numV 2)
  218.              mt-store))
  219.   (test/exn (interp (parse `x) mt-env mt-store)
  220.             "free variable")
  221.   (test (interp (parse `x)
  222.                 (extend-env (bind 'x (numV 9)) mt-env)
  223.                 mt-store)
  224.         (v*s (numV 9)
  225.              mt-store))
  226.   (test (interp (parse `{+ 2 1}) mt-env mt-store)
  227.         (v*s (numV 3)
  228.              mt-store))
  229.   (test (interp (parse `{* 2 1}) mt-env mt-store)
  230.         (v*s (numV 2)
  231.              mt-store))
  232.   (test (interp (parse `{+ {* 2 3} {+ 5 8}})
  233.                 mt-env
  234.                 mt-store)
  235.         (v*s (numV 19)
  236.              mt-store))
  237.   (test (interp (parse `{lambda {x} {+ x x}})
  238.                 mt-env
  239.                 mt-store)
  240.         (v*s (closV 'x (plusE (idE 'x) (idE 'x)) mt-env)
  241.              mt-store))
  242.   (test (interp (parse `{let {[x 5]}
  243.                           {+ x x}})
  244.                 mt-env
  245.                 mt-store)
  246.         (v*s (numV 10)
  247.              mt-store))
  248.   (test (interp (parse `{let {[x 5]}
  249.                           {let {[x {+ 1 x}]}
  250.                             {+ x x}}})
  251.                 mt-env
  252.                 mt-store)
  253.         (v*s (numV 12)
  254.              mt-store))
  255.   (test (interp (parse `{let {[x 5]}
  256.                           {let {[y 6]}
  257.                             x}})
  258.                 mt-env
  259.                 mt-store)
  260.         (v*s (numV 5)
  261.              mt-store))
  262.   (test (interp (parse `{{lambda {x} {+ x x}} 8})
  263.                 mt-env
  264.                 mt-store)
  265.         (v*s (numV 16)
  266.              mt-store))
  267.   (test (interp (parse `{box 5})
  268.                 mt-env
  269.                 mt-store)
  270.         (v*s (boxV 1)
  271.              (override-store (cell 1 (numV 5))
  272.                              mt-store)))
  273.   (test (interp (parse `{unbox {box 5}})
  274.                 mt-env
  275.                 mt-store)
  276.         (v*s (numV 5)
  277.              (override-store (cell 1 (numV 5))
  278.                              mt-store)))
  279.   (test (interp (parse `{set-box! {box 5} 6})
  280.                 mt-env
  281.                 mt-store)
  282.         (v*s (numV 6)
  283.              (override-store (cell 1 (numV 6))
  284.                              (override-store (cell 1 (numV 5))
  285.                                              mt-store))))
  286.   (test (interp (parse `{begin 1 2})
  287.                 mt-env
  288.                 mt-store)
  289.         (v*s (numV 2)
  290.              mt-store))
  291.   (test (interp (parse `{let {[b (box 5)]}
  292.                           {begin
  293.                             {set-box! b 6}
  294.                             {unbox b}}})
  295.                 mt-env
  296.                 mt-store)
  297.         (v*s (numV 6)
  298.              (override-store (cell 1 (numV 6))
  299.                              (override-store (cell 1 (numV 5))
  300.                                              mt-store))))
  301.  
  302.   (test/exn (interp (parse `{1 2}) mt-env mt-store)
  303.             "not a function")
  304.   (test/exn (interp (parse `{+ 1 {lambda {x} x}}) mt-env mt-store)
  305.             "not a number")
  306.   (test/exn (interp (parse `{unbox 1}) mt-env mt-store)
  307.             "not a box")
  308.   (test/exn (interp (parse `{set-box! 1 2}) mt-env mt-store)
  309.             "not a box")
  310.   (test/exn (interp (parse `{let {[bad {lambda {x} {+ x y}}]}
  311.                               {let {[y 5]}
  312.                                 {bad 2}}})
  313.                     mt-env
  314.                     mt-store)
  315.             "free variable"))
  316.  
  317. ;; num+ and num* ----------------------------------------
  318. (define (num-op [op : (Number Number -> Number)] [l : Value] [r : Value]) : Value
  319.   (cond
  320.    [(and (numV? l) (numV? r))
  321.     (numV (op (numV-n l) (numV-n r)))]
  322.    [else
  323.     (error 'interp "not a number")]))
  324. (define (num+ [l : Value] [r : Value]) : Value
  325.   (num-op + l r))
  326. (define (num* [l : Value] [r : Value]) : Value
  327.   (num-op * l r))
  328.  
  329. (module+ test
  330.   (test (num+ (numV 1) (numV 2))
  331.         (numV 3))
  332.   (test (num* (numV 2) (numV 3))
  333.         (numV 6)))
  334.  
  335. ;; lookup ----------------------------------------
  336. (define (lookup [n : Symbol] [env : Env]) : Value
  337.   (type-case (Listof Binding) env
  338.    [empty (error 'lookup "free variable")]
  339.    [(cons b rst-env) (cond
  340.                        [(symbol=? n (bind-name b))
  341.                         (bind-val b)]
  342.                        [else (lookup n rst-env)])]))
  343.  
  344. (module+ test
  345.   (test/exn (lookup 'x mt-env)
  346.             "free variable")
  347.   (test (lookup 'x (extend-env (bind 'x (numV 8)) mt-env))
  348.         (numV 8))
  349.   (test (lookup 'x (extend-env
  350.                     (bind 'x (numV 9))
  351.                     (extend-env (bind 'x (numV 8)) mt-env)))
  352.         (numV 9))
  353.   (test (lookup 'y (extend-env
  354.                     (bind 'x (numV 9))
  355.                     (extend-env (bind 'y (numV 8)) mt-env)))
  356.         (numV 8)))
  357.  
  358. ;; store operations ----------------------------------------
  359.  
  360. (define (new-loc [sto : Store]) : Location
  361.   (+ 1 (max-address sto)))
  362.  
  363. (define (max-address [sto : Store]) : Location
  364.   (type-case (Listof Storage) sto
  365.    [empty 0]
  366.    [(cons c rst-sto) (max (cell-location c)
  367.                           (max-address rst-sto))]))
  368.  
  369. (define (fetch [l : Location] [sto : Store]) : Value
  370.   (type-case (Listof Storage) sto
  371.    [empty (error 'interp "unallocated location")]
  372.    [(cons c rst-sto) (if (equal? l (cell-location c))
  373.                          (cell-val c)
  374.                          (fetch l rst-sto))]))
  375.  
  376. (module+ test
  377.   (test (max-address mt-store)
  378.         0)
  379.   (test (max-address (override-store (cell 2 (numV 9))
  380.                                      mt-store))
  381.         2)
  382.  
  383.   (test (fetch 2 (override-store (cell 2 (numV 9))
  384.                                  mt-store))
  385.         (numV 9))
  386.   (test (fetch 2 (override-store (cell 2 (numV 10))
  387.                                  (override-store (cell 2 (numV 9))
  388.                                                  mt-store)))
  389.         (numV 10))
  390.   (test (fetch 3 (override-store (cell 2 (numV 10))
  391.                                  (override-store (cell 3 (numV 9))
  392.                                                  mt-store)))
  393.         (numV 9))
  394.   (test/exn (fetch 2 mt-store)
  395.             "unallocated location")
  396.  
  397.  
  398.   ; two new tests for testing part 1) and part 2) added:
  399.   (test (interp (parse `{let {[b {box 1}]}
  400.                           {begin
  401.                             {set-box! b 2}
  402.                             {unbox b}}})
  403.                 mt-env
  404.                 mt-store)
  405.         (v*s (numV 2)
  406.              (override-store (cell 1 (numV 2))
  407.                              mt-store)))
  408.  
  409.   (test (interp (parse `{let {[b {box 1}]}
  410.                           {begin
  411.                             {set-box! b {+ 2 {unbox b}}}
  412.                             {set-box! b {+ 3 {unbox b}}}
  413.                             {set-box! b {+ 4 {unbox b}}}
  414.                             {unbox b}}})
  415.                 mt-env
  416.                 mt-store)
  417.         (v*s (numV 10)
  418.              (override-store (cell 1 (numV 10))
  419.                              mt-store))))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
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!