haskell: classic program calculator.hs + nested constructor patterns (+5 tests, 402/402)

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>

lib/haskell/tests/program-calculator.sx

@@ -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}

lib/haskell/tests/programs/calculator.hs

@@ -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]