giles
cd489b19be
Some checks are pending
Test, Build, and Deploy / test-build-deploy (push) Waiting to run
118 lines
2.8 KiB
Plaintext
118 lines
2.8 KiB
Plaintext
;; do-notation + stub IO monad. Desugaring is per Haskell 98 §3.14:
|
|
;; do { e ; ss } = e >> do { ss }
|
|
;; do { p <- e ; ss } = e >>= \p -> do { ss }
|
|
;; do { let ds ; ss } = let ds in do { ss }
|
|
;; do { e } = e
|
|
;; The IO type is just `("IO" payload)` for now — no real side
|
|
;; effects yet. `return`, `>>=`, `>>` are built-ins.
|
|
|
|
(define
|
|
hk-prog-val
|
|
(fn
|
|
(src name)
|
|
(hk-deep-force (get (hk-eval-program (hk-core src)) name))))
|
|
|
|
;; ── Single-statement do ──
|
|
(hk-test
|
|
"do with a single expression"
|
|
(hk-eval-expr-source "do { return 5 }")
|
|
(list "IO" 5))
|
|
|
|
(hk-test
|
|
"return wraps any expression"
|
|
(hk-eval-expr-source "return (1 + 2 * 3)")
|
|
(list "IO" 7))
|
|
|
|
;; ── Bind threads results ──
|
|
(hk-test
|
|
"single bind"
|
|
(hk-eval-expr-source
|
|
"do { x <- return 5 ; return (x + 1) }")
|
|
(list "IO" 6))
|
|
|
|
(hk-test
|
|
"two binds"
|
|
(hk-eval-expr-source
|
|
"do\n x <- return 5\n y <- return 7\n return (x + y)")
|
|
(list "IO" 12))
|
|
|
|
(hk-test
|
|
"three binds — accumulating"
|
|
(hk-eval-expr-source
|
|
"do\n a <- return 1\n b <- return 2\n c <- return 3\n return (a + b + c)")
|
|
(list "IO" 6))
|
|
|
|
;; ── Mixing >> and >>= ──
|
|
(hk-test
|
|
">> sequencing — last wins"
|
|
(hk-eval-expr-source
|
|
"do\n return 1\n return 2\n return 3")
|
|
(list "IO" 3))
|
|
|
|
(hk-test
|
|
">> then >>= — last bind wins"
|
|
(hk-eval-expr-source
|
|
"do\n return 99\n x <- return 5\n return x")
|
|
(list "IO" 5))
|
|
|
|
;; ── do-let ──
|
|
(hk-test
|
|
"do-let single binding"
|
|
(hk-eval-expr-source
|
|
"do\n let x = 3\n return (x * 2)")
|
|
(list "IO" 6))
|
|
|
|
(hk-test
|
|
"do-let multi-bind, used after"
|
|
(hk-eval-expr-source
|
|
"do\n let x = 4\n y = 5\n return (x * y)")
|
|
(list "IO" 20))
|
|
|
|
(hk-test
|
|
"do-let interleaved with bind"
|
|
(hk-eval-expr-source
|
|
"do\n x <- return 10\n let y = x + 1\n return (x * y)")
|
|
(list "IO" 110))
|
|
|
|
;; ── Bind + pattern ──
|
|
(hk-test
|
|
"bind to constructor pattern"
|
|
(hk-eval-expr-source
|
|
"do\n Just x <- return (Just 7)\n return (x + 100)")
|
|
(list "IO" 107))
|
|
|
|
(hk-test
|
|
"bind to tuple pattern"
|
|
(hk-eval-expr-source
|
|
"do\n (a, b) <- return (3, 4)\n return (a * b)")
|
|
(list "IO" 12))
|
|
|
|
;; ── User-defined IO functions ──
|
|
(hk-test
|
|
"do inside top-level fun"
|
|
(hk-prog-val
|
|
"addM x y = do\n a <- return x\n b <- return y\n return (a + b)\nresult = addM 5 6"
|
|
"result")
|
|
(list "IO" 11))
|
|
|
|
(hk-test
|
|
"nested do"
|
|
(hk-eval-expr-source
|
|
"do\n x <- do { y <- return 3 ; return (y + 1) }\n return (x * 2)")
|
|
(list "IO" 8))
|
|
|
|
;; ── (>>=) and (>>) used directly as functions ──
|
|
(hk-test
|
|
">>= used directly"
|
|
(hk-eval-expr-source
|
|
"(return 4) >>= (\\x -> return (x + 100))")
|
|
(list "IO" 104))
|
|
|
|
(hk-test
|
|
">> used directly"
|
|
(hk-eval-expr-source
|
|
"(return 1) >> (return 2)")
|
|
(list "IO" 2))
|
|
|
|
{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
|