Done with compilation.
This commit is contained in:
+54
-42
@@ -30,11 +30,11 @@ POSTT :== PUWAE
|
||||
[Sub PUWAE PUWAE]
|
||||
[Mul PUWAE PUWAE]
|
||||
[Div PUWAE PUWAE]
|
||||
; [Post (Listof POSTT)]
|
||||
[Post (Listof POSTT)]
|
||||
[With Symbol PUWAE PUWAE])
|
||||
|
||||
(define-type POSTT = (U '+ '- '* '/ PUWAE))
|
||||
|
||||
|
||||
(: parse : (String -> PUWAE))
|
||||
;; parse the string into our language
|
||||
(define (parse str)
|
||||
@@ -50,49 +50,27 @@ POSTT :== PUWAE
|
||||
[(list '- l r) (Sub (sexpr->puwae l) (sexpr->puwae r))]
|
||||
[(list '* l r) (Mul (sexpr->puwae l) (sexpr->puwae r))]
|
||||
[(list '/ l r) (Div (sexpr->puwae l) (sexpr->puwae r))]
|
||||
[(list 'post posts ...) (parsepost posts '())]
|
||||
[(list 'post posts ...) (Post (sexpr-list->postts posts))]
|
||||
[(list 'with (list (symbol: id) val) bound-body)
|
||||
(With id (sexpr->puwae val) (sexpr->puwae bound-body))]
|
||||
[_ (error 'sexpr->puwae "malformed expression in ~s" sexpr)]))
|
||||
|
||||
(: parsepost : (Sexpr (Listof PUWAE) -> PUWAE))
|
||||
; Parse a post expression into a PUWAE.
|
||||
(define (parsepost sexpr glob)
|
||||
(: sexpr->postt : (Sexpr -> POSTT))
|
||||
;; Turn a post into POSTT.
|
||||
(define (sexpr->postt sexpr)
|
||||
(match sexpr
|
||||
['() (if (= 1 (length glob)) (first glob) (error 'parsepost "finished with messy glob: ~s" glob))] ; There shouldn't be anything else left in the stack.
|
||||
[(cons '+ rest) (parsepost rest (parsepost-sum glob))]
|
||||
[(cons '- rest) (parsepost rest (parsepost-sub glob))]
|
||||
[(cons '* rest) (parsepost rest (parsepost-mul glob))]
|
||||
[(cons '/ rest) (parsepost rest (parsepost-div glob))]
|
||||
[(cons (symbol: id) rest) (parsepost rest (cons (Id id) glob))] ; Capture non-post symbols (variables).
|
||||
[(cons exp rest) (parsepost rest (cons (sexpr->puwae exp) glob))])) ; Assume anything else must be a PUWAE.
|
||||
['+ '+]
|
||||
['- '-]
|
||||
['* '*]
|
||||
['/ '/]
|
||||
[_ (sexpr->puwae sexpr)]))
|
||||
|
||||
(: glob-swap : Symbol (Listof PUWAE) (PUWAE PUWAE -> PUWAE) -> (Listof PUWAE))
|
||||
; Validates the glob length before swapping with result of globberator.
|
||||
(define (glob-swap operation glob globberator)
|
||||
(if (>= (length glob) 2)
|
||||
(cons (globberator (second glob) (first glob)) (rest (rest glob))) ; Replace the two arguments, while preserving whatever else was on the stack.
|
||||
(error 'glob-swap "too few arguments globbed for ~s: ~s" operation glob)))
|
||||
|
||||
(: parsepost-sum : ((Listof PUWAE) -> (Listof PUWAE)))
|
||||
; Parse a post sum.
|
||||
(define (parsepost-sum glob)
|
||||
(glob-swap 'sum glob Sum))
|
||||
|
||||
(: parsepost-mul : ((Listof PUWAE) -> (Listof PUWAE)))
|
||||
; Parse a post product.
|
||||
(define (parsepost-mul glob)
|
||||
(glob-swap 'mul glob Mul))
|
||||
|
||||
(: parsepost-sub : ((Listof PUWAE) -> (Listof PUWAE)))
|
||||
; Parse a post subtration.
|
||||
(define (parsepost-sub glob)
|
||||
(glob-swap 'sub glob Sub))
|
||||
|
||||
(: parsepost-div : ((Listof PUWAE) -> (Listof PUWAE)))
|
||||
; Parse a post quotient.
|
||||
(define (parsepost-div glob)
|
||||
(glob-swap 'div glob Div))
|
||||
(: sexpr-list->postts : ((Listof Sexpr) -> (Listof POSTT)))
|
||||
(define (sexpr-list->postts sexprs)
|
||||
(match sexprs
|
||||
['() '()]
|
||||
[(cons token rest)
|
||||
(cons (sexpr->postt token) (sexpr-list->postts rest))]))
|
||||
|
||||
(: eval : (PUWAE -> Number))
|
||||
;; evaluate to a final number
|
||||
@@ -104,8 +82,32 @@ POSTT :== PUWAE
|
||||
[(Sub l r) (- (eval l) (eval r))]
|
||||
[(Mul l r) (* (eval l) (eval r))]
|
||||
[(Div l r) (/ (eval l) (eval r))]
|
||||
[(Post postts) (eval-post postts '())]
|
||||
[(With id pre-val bound-body) (eval (subst id (Num (eval pre-val)) bound-body))]))
|
||||
|
||||
(: post-stack-apply : (Symbol (Number Number -> Number) (Listof Number) -> (Listof Number)))
|
||||
(define (post-stack-apply operator operation stack)
|
||||
(if (>= (length stack) 2)
|
||||
(cons (operation (second stack) (first stack)) (rest (rest stack)))
|
||||
(error 'eval-post "Too few arguments for ~s: ~s" operator stack)))
|
||||
|
||||
(: eval-post : ((Listof POSTT) (Listof Number) -> Number))
|
||||
(define (eval-post postts stack)
|
||||
(match postts
|
||||
['()
|
||||
(if (= 1 (length stack))
|
||||
(first stack)
|
||||
(error 'eval-post "Finished with messy stack: ~s" stack))]
|
||||
[(cons token rest)
|
||||
(if (symbol? token)
|
||||
(match token
|
||||
['+ (eval-post rest (post-stack-apply '+ + stack))]
|
||||
['- (eval-post rest (post-stack-apply '- - stack))]
|
||||
['* (eval-post rest (post-stack-apply '* * stack))]
|
||||
['/ (eval-post rest (post-stack-apply '/ / stack))]
|
||||
[_ (error 'eval-post "Bad post operator ~s" token)])
|
||||
(eval-post rest (cons (eval token) stack)))]))
|
||||
|
||||
(: subst : (Symbol PUWAE PUWAE -> PUWAE))
|
||||
;; subst all instances of id with val in body
|
||||
(define (subst id val body)
|
||||
@@ -116,6 +118,7 @@ POSTT :== PUWAE
|
||||
[(Sub l r) (Sub (subst id val l) (subst id val r))]
|
||||
[(Mul l r) (Mul (subst id val l) (subst id val r))]
|
||||
[(Div l r) (Div (subst id val l) (subst id val r))]
|
||||
[(Post postts) (Post (subst-postts id val postts))]
|
||||
[(With other-id pre-val bound-body)
|
||||
(With other-id
|
||||
(subst id val pre-val)
|
||||
@@ -123,6 +126,15 @@ POSTT :== PUWAE
|
||||
bound-body
|
||||
(subst id val bound-body)))]))
|
||||
|
||||
(: subst-postts : (Symbol PUWAE (Listof POSTT) -> (Listof POSTT)))
|
||||
(define (subst-postts id val postts)
|
||||
(match postts
|
||||
['() '()]
|
||||
[(cons token rest)
|
||||
(if (symbol? token)
|
||||
(cons token (subst-postts id val rest))
|
||||
(cons (subst id val token) (subst-postts id val rest)))]))
|
||||
|
||||
(: run : String -> Number)
|
||||
;; run the program
|
||||
(define (run str)
|
||||
@@ -139,9 +151,9 @@ POSTT :== PUWAE
|
||||
(test (run "{with {x {post 1 3 +}} {post 5 6 + x *}}") => 44)
|
||||
(test (run "{post 1 3 + 5 6 + *}") => 44) ; Not 48 :P (5 + 6 ≠ 12).
|
||||
|
||||
(test (run "{post 3 +}") =error> "glob-swap: too few arguments globbed for sum: ((Num 3))")
|
||||
(test (run "{post 3 3 3 +}") =error> "parsepost: finished with messy glob: ((Sum (Num 3) (Num 3)) (Num 3))")
|
||||
(test (run "{post 1 2 + 2}") =error> "parsepost: finished with messy glob: ((Num 2) (Sum (Num 1) (Num 2)))")
|
||||
(test (run "{post 3 +}") =error> "eval-post: Too few arguments for +: (3)")
|
||||
(test (run "{post 3 3 3 +}") =error> "eval-post: Finished with messy stack: (6 3)")
|
||||
(test (run "{post 1 2 + 2}") =error> "eval-post: Finished with messy stack: (2 3)")
|
||||
|
||||
(test (run "4") => 4)
|
||||
(test (run "{+ 4 {* 2 3}}") => 10)
|
||||
|
||||
Reference in New Issue
Block a user