Compare commits
2 Commits
2b117288f6
...
161fa613f2
| Author | SHA1 | Date | |
|---|---|---|---|
| 161fa613f2 | |||
| ba63cdf8c4 |
55
lib/haskell/tests/program-calculator.sx
Normal file
55
lib/haskell/tests/program-calculator.sx
Normal file
@@ -0,0 +1,55 @@
|
||||
;; 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}
|
||||
40
lib/haskell/tests/programs/calculator.hs
Normal file
40
lib/haskell/tests/programs/calculator.hs
Normal file
@@ -0,0 +1,40 @@
|
||||
-- calculator.hs — recursive descent expression evaluator.
|
||||
--
|
||||
-- Tokens are represented as an ADT; the parser threads a [Token] list
|
||||
-- through a custom Result type so pattern matching can destructure the
|
||||
-- pair (value, remaining-tokens) directly inside constructor patterns.
|
||||
--
|
||||
-- Operator precedence: * and / bind tighter than + and -.
|
||||
-- All operators are left-associative.
|
||||
|
||||
data Token = TNum Int | TOp String
|
||||
data Result = R Int [Token]
|
||||
|
||||
getV (R v _) = v
|
||||
getR (R _ r) = r
|
||||
|
||||
eval ts = getV (parseExpr ts)
|
||||
|
||||
parseExpr ts = parseExprRest (parseTerm ts)
|
||||
|
||||
parseExprRest (R v (TOp "+":rest)) =
|
||||
let t = parseTerm rest
|
||||
in parseExprRest (R (v + getV t) (getR t))
|
||||
parseExprRest (R v (TOp "-":rest)) =
|
||||
let t = parseTerm rest
|
||||
in parseExprRest (R (v - getV t) (getR t))
|
||||
parseExprRest r = r
|
||||
|
||||
parseTerm ts = parseTermRest (parseFactor ts)
|
||||
|
||||
parseTermRest (R v (TOp "*":rest)) =
|
||||
let t = parseFactor rest
|
||||
in parseTermRest (R (v * getV t) (getR t))
|
||||
parseTermRest (R v (TOp "/":rest)) =
|
||||
let t = parseFactor rest
|
||||
in parseTermRest (R (v `div` getV t) (getR t))
|
||||
parseTermRest r = r
|
||||
|
||||
parseFactor (TNum n:rest) = R n rest
|
||||
|
||||
result = eval [TNum 2, TOp "+", TNum 3, TOp "*", TNum 4]
|
||||
@@ -86,9 +86,9 @@ Key mappings:
|
||||
- [x] `sieve.hs` — lazy sieve of Eratosthenes
|
||||
- [x] `quicksort.hs` — naive QS
|
||||
- [x] `nqueens.hs`
|
||||
- [ ] `calculator.hs` — parser combinator style expression evaluator
|
||||
- [x] `calculator.hs` — parser combinator style expression evaluator
|
||||
- [ ] `lib/haskell/conformance.sh` + runner; `scoreboard.json` + `scoreboard.md`
|
||||
- [ ] Target: 5/5 classic programs passing
|
||||
- [x] Target: 5/5 classic programs passing
|
||||
|
||||
### Phase 4 — Hindley-Milner inference
|
||||
- [ ] Algorithm W: unification + type schemes + generalisation + instantiation
|
||||
@@ -114,6 +114,15 @@ Key mappings:
|
||||
|
||||
_Newest first._
|
||||
|
||||
- **2026-04-25** — Classic program `calculator.hs`: recursive descent
|
||||
expression evaluator using ADTs for tokens and results.
|
||||
`data Token = TNum Int | TOp String` + `data Result = R Int [Token]`;
|
||||
parser threads token lists through `R` constructors enabling nested
|
||||
constructor pattern matching (`R v (TOp "+":rest)`). Handles two-level
|
||||
operator precedence (* / tighter than + −) and left-associativity.
|
||||
5 tests: addition, precedence, left-assoc subtraction, left-assoc
|
||||
div+mul, single number. All 5 classic programs complete. 402/402 green.
|
||||
|
||||
- **2026-04-25** — Classic program `nqueens.hs`: backtracking n-queens via list
|
||||
comprehension and multi-clause `where`. Three fixes needed: (1) `hk-eval-let`
|
||||
now delegates to `hk-bind-decls!` so multi-clause `where`/`let` bindings
|
||||
|
||||
Reference in New Issue
Block a user