IsaacShoebottom/CS4613
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Finish 2 minus1k

Browse Source
This commit is contained in:
Isaac Shoebottom
2025-04-24 09:32:20 -03:00
parent 7cf2339c16
commit 6c1c698514
1 changed files with 40 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

43
Final/2.rkt
View File

@ -7,6 +7,7 @@
[appE (fun-expr : Exp) (arg-expr : Exp)] [appE (fun-expr : Exp) (arg-expr : Exp)]
[errorE (msg : String)] ;; New [errorE (msg : String)] ;; New
[if0E (test : Exp) (then : Exp) (else : Exp)] [if0E (test : Exp) (then : Exp) (else : Exp)]
[minus1E (n : Exp)]
) )
(define-type Value (define-type Value
@ -43,6 +44,7 @@
(k : Continuation)] (k : Continuation)]
[doMinusK (v1 : Value) [doMinusK (v1 : Value)
(k : Continuation)] (k : Continuation)]
[doMinus1K (k : Continuation)]
[appArgK (arg-expr : Exp) [appArgK (arg-expr : Exp)
(env : Env) (env : Env)
(k : Continuation)] (k : Continuation)]
@ -77,8 +79,8 @@
(lamE varE body))] (lamE varE body))]
[(s-exp-match? `(error STRING) sx) (errorE (s-exp->string (sx-ref sx 1)))] [(s-exp-match? `(error STRING) sx) (errorE (s-exp->string (sx-ref sx 1)))]
[(s-exp-match? `(error ANY) sx) (parse-error sx)] [(s-exp-match? `(error ANY) sx) (parse-error sx)]
[(s-exp-match? `(ANY ANY) sx) [(s-exp-match? `(-- ANY) sx) (minus1E (px 1))]
(appE (px 0) (px 1))] [(s-exp-match? `(ANY ANY) sx) (appE (px 0) (px 1))]
[(s-exp-list? sx) [(s-exp-list? sx)
(case (s-exp->symbol (sx-ref sx 0)) (case (s-exp->symbol (sx-ref sx 0))
[(+) (plusE (px 1) (px 2))] [(+) (plusE (px 1) (px 2))]
@ -113,7 +115,7 @@
(interp fun-expr env (appArgK arg-expr env k))] (interp fun-expr env (appArgK arg-expr env k))]
[(if0E test-expr then-expr else-expr) [(if0E test-expr then-expr else-expr)
(interp test-expr env (doIfK then-expr else-expr env k))] (interp test-expr env (doIfK then-expr else-expr env k))]
[(minus1E n) (interp n env (doMinus1K k))]
)) ))
(define (continue [k : Continuation] [v : Value]) : Value (define (continue [k : Continuation] [v : Value]) : Value
@ -127,6 +129,8 @@
(interp r env (doMinusK v next-k))] (interp r env (doMinusK v next-k))]
[(doMinusK v1 next-k) [(doMinusK v1 next-k)
(continue next-k (arith-op - v1 v))] (continue next-k (arith-op - v1 v))]
[(doMinus1K next-k)
(continue next-k (arith-op - v (numV 1)))]
[(appArgK arg-expr env next-k) [(appArgK arg-expr env next-k)
(interp arg-expr env (doAppK v next-k))] (interp arg-expr env (doAppK v next-k))]
[(doAppK fun-val next-k) [(doAppK fun-val next-k)
@ -240,3 +244,36 @@
{body-proc {lam {x} {{fX fX} x}}}}}}}) {body-proc {lam {x} {{fX fX} x}}}}}}})
(errorV "reached zero")) (errorV "reached zero"))
) )
; unary decrement
(module+ test
(test (parse `{-- 2}) (minus1E (numE 2))))
(module+ test
(test (run `{-- 2}) (numV 1))
(test (run `{{lam {x} {-- x}} 3}) (numV 2))
(test (run `{{lam {y} {+ {-- y} {-- y}}} 10}) (numV 18))
(test (run `{{lam {f} {f 4}} {lam {x} {-- x}}}) (numV 3)))
; multiplication
(module+ test
(define fact-prog
`{{lam {mkrec}
{{lam {fact}
;; Call fact on 5:
{fact 5}}
;; Create recursive fact
{mkrec
{lam {fact}
{lam {n}
{if0 n
1
{* n {fact {-- n}}}}}}}}}
;; mkrec:
{lam {body-proc}
{{lam {fX}
{fX fX}}
{lam {fX}
{body-proc {lam {x} {{fX fX} x}}}}}}})
(test (run fact-prog) (numV 120)))