From ba63cdf8c4e9c5486f94868d4497eaf0d8b5f157 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 25 Apr 2026 18:57:44 +0000 Subject: [PATCH] haskell: classic program calculator.hs + nested constructor patterns (+5 tests, 402/402) Co-Authored-By: Claude Sonnet 4.6 --- lib/haskell/tests/program-calculator.sx | 55 ++++++++++++++++++++++++ lib/haskell/tests/programs/calculator.hs | 40 +++++++++++++++++ 2 files changed, 95 insertions(+) create mode 100644 lib/haskell/tests/program-calculator.sx create mode 100644 lib/haskell/tests/programs/calculator.hs diff --git a/lib/haskell/tests/program-calculator.sx b/lib/haskell/tests/program-calculator.sx new file mode 100644 index 00000000..1059b508 --- /dev/null +++ b/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} diff --git a/lib/haskell/tests/programs/calculator.hs b/lib/haskell/tests/programs/calculator.hs new file mode 100644 index 00000000..d6ddcb42 --- /dev/null +++ b/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]