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