56 lines
2.1 KiB
Plaintext
56 lines
2.1 KiB
Plaintext
;; calculator.hs — recursive descent expression evaluator.
|
|
;;
|
|
;; Exercises:
|
|
;; - ADTs with constructor fields: TNum Int, TOp String, R Int [Token]
|
|
;; - Nested constructor pattern matching: (R v (TOp "+":rest))
|
|
;; - let bindings in function bodies
|
|
;; - Integer arithmetic including `div` (backtick infix)
|
|
;; - Left-associative multi-level operator precedence
|
|
|
|
(define
|
|
hk-prog-val
|
|
(fn
|
|
(src name)
|
|
(hk-deep-force (get (hk-eval-program (hk-core src)) name))))
|
|
|
|
(define
|
|
hk-calc-src
|
|
"data Token = TNum Int | TOp String\ndata Result = R Int [Token]\ngetV (R v _) = v\ngetR (R _ r) = r\neval ts = getV (parseExpr ts)\nparseExpr ts = parseExprRest (parseTerm ts)\nparseExprRest (R v (TOp \"+\":rest)) =\n let t = parseTerm rest\n in parseExprRest (R (v + getV t) (getR t))\nparseExprRest (R v (TOp \"-\":rest)) =\n let t = parseTerm rest\n in parseExprRest (R (v - getV t) (getR t))\nparseExprRest r = r\nparseTerm ts = parseTermRest (parseFactor ts)\nparseTermRest (R v (TOp \"*\":rest)) =\n let t = parseFactor rest\n in parseTermRest (R (v * getV t) (getR t))\nparseTermRest (R v (TOp \"/\":rest)) =\n let t = parseFactor rest\n in parseTermRest (R (v `div` getV t) (getR t))\nparseTermRest r = r\nparseFactor (TNum n:rest) = R n rest\n")
|
|
|
|
(hk-test
|
|
"calculator: 2 + 3 = 5"
|
|
(hk-prog-val
|
|
(str hk-calc-src "result = eval [TNum 2, TOp \"+\", TNum 3]\n")
|
|
"result")
|
|
5)
|
|
|
|
(hk-test
|
|
"calculator: 2 + 3 * 4 = 14 (precedence)"
|
|
(hk-prog-val
|
|
(str hk-calc-src "result = eval [TNum 2, TOp \"+\", TNum 3, TOp \"*\", TNum 4]\n")
|
|
"result")
|
|
14)
|
|
|
|
(hk-test
|
|
"calculator: 10 - 3 - 2 = 5 (left-assoc)"
|
|
(hk-prog-val
|
|
(str hk-calc-src "result = eval [TNum 10, TOp \"-\", TNum 3, TOp \"-\", TNum 2]\n")
|
|
"result")
|
|
5)
|
|
|
|
(hk-test
|
|
"calculator: 6 / 2 * 3 = 9 (left-assoc)"
|
|
(hk-prog-val
|
|
(str hk-calc-src "result = eval [TNum 6, TOp \"/\", TNum 2, TOp \"*\", TNum 3]\n")
|
|
"result")
|
|
9)
|
|
|
|
(hk-test
|
|
"calculator: single number"
|
|
(hk-prog-val
|
|
(str hk-calc-src "result = eval [TNum 42]\n")
|
|
"result")
|
|
42)
|
|
|
|
{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
|