haskell: real IO monad — putStrLn/print/putStr + hk-run-io (+10 tests, 575/575)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 20s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 20s
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -683,7 +683,41 @@
|
||||
(dict-set! env "quot" (hk-make-binop-builtin "quot" "quot"))
|
||||
(dict-set! env "show" (hk-mk-lazy-builtin "show" hk-show-val 1))
|
||||
(hk-load-into! env hk-prelude-src)
|
||||
env)))
|
||||
(do
|
||||
(dict-set!
|
||||
env
|
||||
"putStrLn"
|
||||
(hk-mk-lazy-builtin
|
||||
"putStrLn"
|
||||
(fn
|
||||
(s)
|
||||
(do
|
||||
(append! hk-io-lines (hk-force s))
|
||||
(list "IO" (list "Tuple"))))
|
||||
1))
|
||||
(dict-set!
|
||||
env
|
||||
"putStr"
|
||||
(hk-mk-lazy-builtin
|
||||
"putStr"
|
||||
(fn
|
||||
(s)
|
||||
(do
|
||||
(append! hk-io-lines (hk-force s))
|
||||
(list "IO" (list "Tuple"))))
|
||||
1))
|
||||
(dict-set!
|
||||
env
|
||||
"print"
|
||||
(hk-mk-lazy-builtin
|
||||
"print"
|
||||
(fn
|
||||
(x)
|
||||
(do
|
||||
(append! hk-io-lines (hk-show-val x))
|
||||
(list "IO" (list "Tuple"))))
|
||||
1))
|
||||
env))))
|
||||
|
||||
;; Eagerly build the Prelude env once at load time; each call to
|
||||
;; hk-eval-expr-source copies it instead of re-parsing the whole Prelude.
|
||||
@@ -905,6 +939,12 @@
|
||||
((env (hk-eval-program (hk-core src))))
|
||||
(cond ((has-key? env "main") (get env "main")) (:else env)))))
|
||||
|
||||
(define hk-io-lines (list))
|
||||
|
||||
(define
|
||||
hk-run-io
|
||||
(fn (src) (do (set! hk-io-lines (list)) (hk-run src) hk-io-lines)))
|
||||
|
||||
(define hk-env0 (hk-init-env))
|
||||
|
||||
(define
|
||||
|
||||
49
lib/haskell/tests/program-io.sx
Normal file
49
lib/haskell/tests/program-io.sx
Normal file
@@ -0,0 +1,49 @@
|
||||
;; program-io.sx — tests for real IO monad (putStrLn, print, putStr).
|
||||
|
||||
(hk-test
|
||||
"putStrLn single line"
|
||||
(hk-run-io "main = putStrLn \"hello\"")
|
||||
(list "hello"))
|
||||
|
||||
(hk-test
|
||||
"putStrLn two lines via do"
|
||||
(hk-run-io "main = do { putStrLn \"a\"; putStrLn \"b\" }")
|
||||
(list "a" "b"))
|
||||
|
||||
(hk-test "print Int" (hk-run-io "main = print 42") (list "42"))
|
||||
|
||||
(hk-test "print Bool True" (hk-run-io "main = print True") (list "True"))
|
||||
|
||||
(hk-test
|
||||
"putStr collects string"
|
||||
(hk-run-io "main = putStr \"hello\"")
|
||||
(list "hello"))
|
||||
|
||||
(hk-test
|
||||
"do with let then putStrLn"
|
||||
(hk-run-io "main = do\n let s = \"world\"\n putStrLn s")
|
||||
(list "world"))
|
||||
|
||||
(hk-test
|
||||
"do sequence three lines"
|
||||
(hk-run-io "main = do { putStrLn \"1\"; putStrLn \"2\"; putStrLn \"3\" }")
|
||||
(list "1" "2" "3"))
|
||||
|
||||
(hk-test
|
||||
"print computed value"
|
||||
(hk-run-io "main = print (6 * 7)")
|
||||
(list "42"))
|
||||
|
||||
(hk-test
|
||||
"putStrLn returns IO unit"
|
||||
(hk-deep-force (hk-run "main = putStrLn \"hi\""))
|
||||
(list "IO" (list "Tuple")))
|
||||
|
||||
(hk-test
|
||||
"hk-run-io resets between calls"
|
||||
(begin
|
||||
(hk-run-io "main = putStrLn \"first\"")
|
||||
(hk-run-io "main = putStrLn \"second\""))
|
||||
(list "second"))
|
||||
|
||||
{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
|
||||
Reference in New Issue
Block a user