API tools faq
paste
Advertisement
Guest User

hw10 - all three parts

a guest
Apr 24th, 2024
191
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Racket 17.84 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.   (boolV [b : Boolean])
  9.   (pairV [fst : Value]
  10.          [snd : Value]))
  11.  
  12. (define-type Exp
  13.   (numE [n : Number])
  14.   (trueE)
  15.   (falseE)
  16.   (plusE [l : Exp]
  17.          [r : Exp])
  18.   (multE [l : Exp]
  19.          [r : Exp])
  20.   (equalE [l : Exp]
  21.           [r : Exp])
  22.   (lamE [ns : (Listof Symbol)]
  23.         [args-type : (Listof Type)]
  24.         [body : Exp])
  25.   (appE [fun : Exp]
  26.         [args : (Listof Exp)])
  27.   (idE [s : Symbol])
  28.   (ifE [tst : Exp]
  29.        [thn : Exp]
  30.        [else : Exp])
  31.   (pairE [l : Exp]
  32.          [r : Exp])
  33.   (fstE [a : Exp])
  34.   (sndE [a : Exp]))
  35.  
  36. (define-type Type
  37.   (numT)
  38.   (boolT)
  39.   (arrowT [args : (Listof Type)]
  40.           [result : Type])
  41.   (crossT [fst : Type]
  42.           [snd : Type]))
  43.  
  44. (define-type Binding
  45.   (bind [name : Symbol]
  46.         [val : Value]))
  47.  
  48. (define-type-alias Env (Listof Binding))
  49.  
  50. (define-type Type-Binding
  51.   (tbind [name : Symbol]
  52.          [type : Type]))
  53.  
  54. (define-type-alias Type-Env (Listof Type-Binding))
  55.  
  56. (define mt-env empty)
  57. (define extend-env cons)
  58. (define extend-env* append)
  59.  
  60.  
  61.  
  62. (module+ test
  63.   (print-only-errors #t))
  64.  
  65. ;; parse ----------------------------------------
  66. (define (parse [s : S-Exp]) : Exp
  67.   (cond
  68.     [(s-exp-match? `NUMBER s) (numE (s-exp->number s))]
  69.     [(s-exp-match? `true s) (trueE)]
  70.     [(s-exp-match? `false s) (falseE)]
  71.     [(s-exp-match? `SYMBOL s) (idE (s-exp->symbol s))]
  72.     [(s-exp-match? `{= ANY ANY} s)
  73.      (equalE (parse (second (s-exp->list s)))
  74.             (parse (third (s-exp->list s))))]
  75.     [(s-exp-match? `{if ANY ANY ANY} s)
  76.      (ifE (parse (second (s-exp->list s)))
  77.             (parse (third (s-exp->list s)))
  78.             (parse (fourth (s-exp->list s))))]
  79.     [(s-exp-match? `{pair ANY ANY} s)
  80.      (pairE (parse (second (s-exp->list s)))
  81.             (parse (third (s-exp->list s))))]
  82.     [(s-exp-match? `{fst ANY} s)
  83.      (fstE (parse (second (s-exp->list s))))]
  84.     [(s-exp-match? `{snd ANY} s)
  85.      (sndE (parse (second (s-exp->list s))))]
  86.     [(s-exp-match? `{+ ANY ANY} s)
  87.      (plusE (parse (second (s-exp->list s)))
  88.             (parse (third (s-exp->list s))))]
  89.     [(s-exp-match? `{* ANY ANY} s)
  90.      (multE (parse (second (s-exp->list s)))
  91.             (parse (third (s-exp->list s))))]
  92.     [(s-exp-match? `{let {[SYMBOL : ANY ANY]} ANY} s)
  93.      (let ([bs (s-exp->list (first
  94.                              (s-exp->list (second
  95.                                            (s-exp->list s)))))])
  96.        (appE (lamE (list (s-exp->symbol (first bs)))
  97.                    (list (parse-type (third bs)))
  98.                    (parse (third (s-exp->list s))))
  99.              (list (parse (fourth bs)))))]
  100.  
  101.     [(s-exp-match? `{lambda {[SYMBOL : ANY] ...} ANY} s)
  102.      (let ([args
  103.             (map s-exp->list
  104.                  (s-exp->list
  105.                   (second (s-exp->list s))))])
  106.        (lamE
  107.         (map s-exp->symbol
  108.              (map first args))
  109.         (map parse-type
  110.              (map third args))
  111.         (parse (third (s-exp->list s)))))]
  112.  
  113.     [(s-exp-match? `{ANY ANY ...} s)
  114.      (appE (parse (first (s-exp->list s)))
  115.            (map parse (rest (s-exp->list s))))]
  116.     [else (error 'parse "invalid input")]))
  117.  
  118. (define (parse-type [s : S-Exp]) : Type
  119.   (cond
  120.     [(s-exp-match? `num s)
  121.      (numT)]
  122.     [(s-exp-match? `bool s)
  123.      (boolT)]
  124.     [(s-exp-match? `(ANY ... -> ANY) s)
  125.      (arrowT
  126.       (map parse-type
  127.            (reverse
  128.             (rest
  129.              (rest
  130.                    (reverse (s-exp->list s))))))
  131.       (parse-type (first (reverse (s-exp->list s)))))]
  132.     [(s-exp-match? `(ANY * ANY) s)
  133.      (crossT (parse-type (first (s-exp->list s)))
  134.              (parse-type (third (s-exp->list s))))]
  135.     [else (error 'parse-type "invalid input")]))
  136.  
  137. (module+ test
  138.   (test (parse `2)
  139.         (numE 2))
  140.   (test (parse `x)
  141.         (idE 'x))
  142.   (test (parse `{+ 2 1})
  143.         (plusE (numE 2) (numE 1)))
  144.   (test (parse `{* 3 4})
  145.         (multE (numE 3) (numE 4)))
  146.   (test (parse `{+ {* 3 4} 8})
  147.         (plusE (multE (numE 3) (numE 4))
  148.                (numE 8)))
  149.   (test (parse `{let {[x : num {+ 1 2}]}
  150.                   y})
  151.         (appE (lamE (list'x) (list(numT)) (idE 'y))
  152.               (list (plusE (numE 1) (numE 2)))))
  153.   (test (parse `{lambda {[x : num]} 9})
  154.         (lamE (list 'x) (list (numT)) (numE 9)))
  155.   (test (parse `{double 9})
  156.         (appE (idE 'double) (list (numE 9))))
  157.   (test/exn (parse `{})
  158.             "invalid input")
  159.  
  160.   (test (parse-type `num)
  161.         (numT))
  162.   (test (parse-type `bool)
  163.         (boolT))
  164.   (test (parse-type `(num -> bool))
  165.         (arrowT (list (numT)) (boolT)))
  166.   (test/exn (parse-type `1)
  167.             "invalid input"))
  168.  
  169. ;; interp ----------------------------------------
  170. (define (interp [a : Exp] [env : Env]) : Value
  171.   (type-case Exp a
  172.     [(numE n) (numV n)]
  173.     [(trueE ) (boolV #t)]
  174.     [(falseE ) (boolV #f)]
  175.     [(idE s) (lookup s env)]
  176.     [(equalE l r) (num= (interp l env) (interp r env))]
  177.     [(plusE l r) (num+ (interp l env) (interp r env))]
  178.     [(multE l r) (num* (interp l env) (interp r env))]
  179.     [(pairE l r) (pairV (interp l env) (interp r env))]
  180.     [(fstE a) (type-case Value (interp a env)
  181.                 [(pairV f r) f]
  182.                 [else (error 'interp "not a pair")])]
  183.     [(sndE a) (type-case Value (interp a env)
  184.                 [(pairV f r) r]
  185.                 [else (error 'interp "not a pair")])]
  186.     [(ifE tst thn els)
  187.      (type-case Value (interp tst env)
  188.        [(boolV b)
  189.         (if b
  190.             (interp thn env)
  191.             (interp els env))]
  192.        [else (error 'interp "not a boolean")])]
  193.     [(lamE n t body)
  194.      (closV n body env)]
  195.     [(appE fun args) (type-case Value (interp fun env)
  196.                       [(closV ns body c-env)
  197.                        (interp body
  198.                                (extend-env*
  199.                                 (map2 bind ns
  200.                                       (map (lambda (arg) (interp arg env)) args))
  201.                                 c-env))]
  202.                       [else (error 'interp "not a function")])]))
  203.  
  204. (module+ test
  205.   (test (interp (parse `2) mt-env)
  206.         (numV 2))
  207.   (test/exn (interp (parse `x) mt-env)
  208.             "free variable")
  209.   (test (interp (parse `x)
  210.                 (extend-env (bind 'x (numV 9)) mt-env))
  211.         (numV 9))
  212.   (test (interp (parse `{+ 2 1}) mt-env)
  213.         (numV 3))
  214.   (test (interp (parse `{* 2 1}) mt-env)
  215.         (numV 2))
  216.   (test (interp (parse `{+ {* 2 3} {+ 5 8}})
  217.                 mt-env)
  218.         (numV 19))
  219.   (test (interp (parse `{lambda {[x : num]} {+ x x}})
  220.                 mt-env)
  221.         (closV (list 'x) (plusE (idE 'x) (idE 'x)) mt-env))
  222.   (test (interp (parse `{let {[x : num 5]}
  223.                           {+ x x}})
  224.                 mt-env)
  225.         (numV 10))
  226.   (test (interp (parse `{let {[x : num 5]}
  227.                           {let {[x : num {+ 1 x}]}
  228.                             {+ x x}}})
  229.                 mt-env)
  230.         (numV 12))
  231.   (test (interp (parse `{let {[x : num 5]}
  232.                           {let {[y : num 6]}
  233.                             x}})
  234.                 mt-env)
  235.         (numV 5))
  236.   (test (interp (parse `{{lambda {[x : num]} {+ x x}} 8})
  237.                 mt-env)
  238.         (numV 16))
  239.  
  240.   (test/exn (interp (parse `{1 2}) mt-env)
  241.             "not a function")
  242.   (test/exn (interp (parse `{+ 1 {lambda {[x : num]} x}}) mt-env)
  243.             "not a number")
  244.   (test/exn (interp (parse `{let {[bad : (num -> num) {lambda {[x : num]} {+ x y}}]}
  245.                               {let {[y : num 5]}
  246.                                 {bad 2}}})
  247.                     mt-env)
  248.             "free variable")
  249.   (test/exn (interp (parse `{if 1 4 5})
  250.                     mt-env)
  251.             "not a boolean")
  252.   (test/exn (interp (parse `{fst 1}) mt-env)
  253.             "not a pair")
  254.   (test/exn (interp (parse `{snd 1}) mt-env)
  255.             "not a pair"))
  256.  
  257. ;; num+ and num* ----------------------------------------
  258. (define (num-op [op : (Number Number -> Number)] [l : Value] [r : Value]) : Value
  259.   (cond
  260.    [(and (numV? l) (numV? r))
  261.     (numV (op (numV-n l) (numV-n r)))]
  262.    [else
  263.     (error 'interp "not a number")]))
  264. (define (num+ [l : Value] [r : Value]) : Value
  265.   (num-op + l r))
  266. (define (num* [l : Value] [r : Value]) : Value
  267.   (num-op * l r))
  268.  
  269. (module+ test
  270.   (test (num+ (numV 1) (numV 2))
  271.         (numV 3))
  272.   (test (num* (numV 2) (numV 3))
  273.         (numV 6)))
  274.  
  275.  
  276. (define (num-eq-op [eq : (Number Number -> Boolean)] [l : Value] [r : Value]) : Value
  277.   (cond
  278.     [(and (numV? l) (numV? r))
  279.      (boolV (eq (numV-n l) (numV-n r)))]
  280.     [else
  281.      (error 'interp "not a number")]))
  282. (define (num= [l : Value] [r : Value]) : Value
  283.   (num-eq-op = l r))
  284.  
  285. (module+ test
  286.   (test (num= (numV 1) (numV 2))
  287.         (boolV #f))
  288.   (test (num= (numV 1) (numV 1))
  289.         (boolV #t))
  290.   (test/exn (num= (numV 1) (boolV #t))
  291.             "not a number"))
  292.  
  293. ;; lookup ----------------------------------------
  294. (define (make-lookup [name-of : ('a -> Symbol)] [val-of : ('a -> 'b)])
  295.   (lambda ([name : Symbol] [vals : (Listof 'a)]) : 'b
  296.     (type-case (Listof 'a) vals
  297.       [empty (error 'find "free variable")]
  298.       [(cons val rst-vals) (if (equal? name (name-of val))
  299.                                (val-of (first vals))
  300.                                ((make-lookup name-of val-of) name rst-vals))])))
  301.  
  302. (define lookup
  303.   (make-lookup bind-name bind-val))
  304.  
  305. (module+ test
  306.   (test/exn (lookup 'x mt-env)
  307.             "free variable")
  308.   (test (lookup 'x (extend-env (bind 'x (numV 8)) mt-env))
  309.         (numV 8))
  310.   (test (lookup 'x (extend-env
  311.                     (bind 'x (numV 9))
  312.                     (extend-env (bind 'x (numV 8)) mt-env)))
  313.         (numV 9))
  314.   (test (lookup 'y (extend-env
  315.                     (bind 'x (numV 9))
  316.                     (extend-env (bind 'y (numV 8)) mt-env)))
  317.         (numV 8)))
  318.  
  319. ;; typecheck ----------------------------------------
  320. (define (typecheck [a : Exp] [tenv : Type-Env])
  321.   (type-case Exp a
  322.     [(numE n) (numT)]
  323.     [(trueE) (boolT)]
  324.     [(falseE) (boolT)]
  325.     [(pairE l r)
  326.      (crossT (typecheck l tenv) (typecheck r tenv))]
  327.     [(fstE a)
  328.      (type-case Type (typecheck a tenv)
  329.        [(crossT fst snd) fst]
  330.        [else (type-error a "pair")])]
  331.     [(sndE a)
  332.      (type-case Type (typecheck a tenv)
  333.        [(crossT fst snd) snd]
  334.        [else (type-error a "pair")])]
  335.     [(equalE l r) (typecheck-bools l r tenv)]
  336.     [(ifE tst thn els) (typecheck-cond tst thn els tenv)]
  337.     [(plusE l r) (typecheck-nums l r tenv)]
  338.     [(multE l r) (typecheck-nums l r tenv)]
  339.     [(idE n) (type-lookup n tenv)]
  340.     [(lamE ns args-type body)
  341.      (arrowT args-type
  342.              (typecheck body
  343.                         (extend-env* (map2 tbind ns args-type)
  344.                                     tenv)))]
  345.     [(appE fun args)
  346.      (type-case Type (typecheck fun tenv)
  347.        [(arrowT args-type results-type)
  348.         (if (equal? (map (lambda (arg) (typecheck arg tenv)) args) args-type)
  349.             results-type
  350.             (type-error args
  351.                         (to-string args-type)))]
  352.        [else (type-error fun "function")])]))
  353.        
  354.        
  355. (define (typecheck-nums l r tenv)
  356.   (type-case Type (typecheck l tenv)
  357.     [(numT)
  358.      (type-case Type (typecheck r tenv)
  359.        [(numT) (numT)]
  360.        [else (type-error r "num")])]
  361.     [else (type-error l "num")]))
  362.  
  363. (define (typecheck-bools l r tenv)
  364.   (type-case Type (typecheck l tenv)
  365.     [(numT)
  366.      (type-case Type (typecheck r tenv)
  367.        [(numT) (boolT)]
  368.        [else (type-error r "num")])]
  369.     [else (type-error l "num")]))
  370.  
  371. (module+ test
  372.   (test/exn (typecheck-bools (numE 17) (trueE) mt-env)
  373.             "typecheck: no type: (trueE) not num")
  374.   (test/exn (typecheck-bools (trueE) (numE 17) mt-env)
  375.             "typecheck: no type: (trueE) not num"))
  376.  
  377.  
  378. (define (typecheck-cond tst thn els tenv)
  379.   (type-case Type (typecheck tst tenv)
  380.     [(boolT)
  381.      (local [(define thn-type (typecheck thn tenv))]
  382.        (local [(define els-type (typecheck els tenv))]
  383.          (if (equal? thn-type els-type)
  384.              els-type
  385.              (error 'typecheck "input type mismatch"))))]
  386.     [else (type-error tst "bool")]))
  387.  
  388.  
  389. (define (type-error a msg)
  390.   (error 'typecheck (string-append
  391.                      "no type: "
  392.                      (string-append
  393.                       (to-string a)
  394.                       (string-append " not "
  395.                                      msg)))))
  396.  
  397. (define type-lookup
  398.   (make-lookup tbind-name tbind-type))
  399.  
  400. (module+ test
  401.   (test (typecheck (parse `10) mt-env)
  402.         (numT))
  403.   (test (typecheck (parse `{+ 10 17}) mt-env)
  404.         (numT))
  405.   (test (typecheck (parse `{* 10 17}) mt-env)
  406.         (numT))
  407.   (test (typecheck (parse `{lambda {[x : num]} 12}) mt-env)
  408.         (arrowT (list (numT)) (numT)))
  409.   (test (typecheck (parse `{lambda {[x : num]} {lambda {[y : bool]} x}}) mt-env)
  410.         (arrowT (list (numT)) (arrowT (list (boolT))  (numT))))
  411.  
  412.   (test (typecheck (parse `{{lambda {[x : num]} 12}
  413.                             {+ 1 17}})
  414.                    mt-env)
  415.         (numT))
  416.  
  417.   (test (typecheck (parse `{let {[x : num 4]}
  418.                              {let {[f : (num -> num)
  419.                                       {lambda {[y : num]} {+ x y}}]}
  420.                                {f x}}})
  421.                    mt-env)
  422.         (numT))
  423.  
  424.   (test/exn (typecheck (parse `{1 2})
  425.                        mt-env)
  426.             "no type")
  427.   (test/exn (typecheck (parse `{{lambda {[x : bool]} x} 2})
  428.                        mt-env)
  429.             "no type")
  430.   (test/exn (typecheck (parse `{+ 1 {lambda {[x : num]} x}})
  431.                        mt-env)
  432.             "no type")
  433.   (test/exn (typecheck (parse `{* {lambda {[x : num]} x} 1})
  434.                        mt-env)
  435.             "no type"))
  436.  
  437. ;; Tests for Part 1:
  438. (module+ test
  439.     (test (interp (parse `{if true 4 5})
  440.                 mt-env)
  441.          (numV 4))
  442.  
  443.   (test (interp (parse `{if false 4 5})
  444.                 mt-env)
  445.         (numV 5))
  446.  
  447.   (test (interp (parse `{if {= 13 {if {= 1 {+ -1 2}}
  448.                                       12
  449.                                       13}}
  450.                             4
  451.                             5})
  452.                 mt-env)
  453.         (numV 5))
  454.  
  455.   (test (typecheck (parse `{= 13 {if {= 1 {+ -1 2}}
  456.                                      12
  457.                                      13}})
  458.                    mt-env)
  459.         (boolT))
  460.  
  461.   (test (typecheck (parse `{if {= 1 {+ -1 2}}
  462.                                {lambda {[x : num]} {+ x 1}}
  463.                                {lambda {[y : num]} y}})
  464.                    mt-env)
  465.         ;; This result may need to be adjusted after part 3:
  466.         (arrowT (list (numT)) (numT)))
  467.  
  468.   (test/exn (typecheck (parse `{+ 1 {if true true false}})
  469.                        mt-env)
  470.             "no type")
  471.  
  472.   (test/exn (typecheck (parse `{+ 1 {if true true 1}})
  473.                        mt-env)
  474.             "input type mismatch")
  475.   (test/exn (typecheck (parse `{if 1 true false})
  476.                        mt-env)
  477.             "typecheck: no type: (numE 1) not bool")
  478.   )
  479.  
  480. ; Tests for Part 2:
  481. (module+ test
  482.    (test (interp (parse `{pair 10 8})
  483.                 mt-env)
  484.         ;; Your constructor might be different than pairV:
  485.         (pairV (numV 10) (numV 8)))
  486.  
  487.   (test (interp (parse `{fst {pair 10 8}})
  488.                 mt-env)
  489.         (numV 10))
  490.  
  491.   (test (interp (parse `{snd {pair 10 8}})
  492.                 mt-env)
  493.         (numV 8))
  494.  
  495.   (test (interp (parse `{let {[p : (num * num) {pair 10 8}]}
  496.                           {fst p}})
  497.                 mt-env)
  498.         (numV 10))
  499.  
  500.   (test (typecheck (parse `{pair 10 8})
  501.                    mt-env)
  502.         ;; Your constructor might be different than crossT:
  503.         (crossT (numT) (numT)))
  504.  
  505.   (test (typecheck (parse `{fst {pair 10 8}})
  506.                    mt-env)
  507.         (numT))
  508.  
  509.   (test (typecheck (parse `{+ 1 {snd {pair 10 8}}})
  510.                    mt-env)
  511.         (numT))
  512.  
  513.   (test (typecheck (parse `{lambda {[x : (num * bool)]}
  514.                              {fst x}})
  515.                    mt-env)
  516.         ;; Your constructor might be different than crossT:
  517.         (arrowT (list (crossT (numT) (boolT))) (numT)))
  518.  
  519.   (test (typecheck (parse `{{lambda {[x : (num * bool)]}
  520.                               {fst x}}
  521.                             {pair 1 false}})
  522.                    mt-env)
  523.         (numT))
  524.  
  525.   (test (typecheck (parse `{{lambda {[x : (num * bool)]}
  526.                               {snd x}}
  527.                             {pair 1 false}})
  528.                    mt-env)
  529.         (boolT))
  530.  
  531.   (test/exn (typecheck (parse `{fst 10})
  532.                        mt-env)
  533.             "no type")
  534.     (test/exn (typecheck (parse `{snd 10})
  535.                        mt-env)
  536.             "no type")
  537.  
  538.   (test/exn (typecheck (parse `{+ 1 {fst {pair false 8}}})
  539.                        mt-env)
  540.             "no type")
  541.  
  542.   (test/exn (typecheck (parse `{lambda {[x : (num * bool)]}
  543.                                  {if {fst x}
  544.                                      1
  545.                                      2}})
  546.                        mt-env)
  547.             "no type"))
  548.  
  549. ; Tests for Part 3:
  550. (module+ test
  551.   (test (interp (parse `{{lambda {}
  552.                            10}})
  553.                 mt-env)
  554.         (numV 10))
  555.  
  556.   (test (interp (parse `{{lambda {[x : num] [y : num]} {+ x y}}
  557.                          10
  558.                          20})
  559.                 mt-env)
  560.         (numV 30))
  561.  
  562.  
  563.   (test (typecheck (parse `{{lambda {[x : num] [y : bool]} y}
  564.                             10
  565.                             false})
  566.                    mt-env)
  567.         (boolT))
  568.  
  569.   (test/exn (typecheck (parse `{{lambda {[x : num] [y : bool]} y}
  570.                                 false
  571.                                 10})
  572.                        mt-env)
  573.             "no type"))
  574.  
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!