haskell: getLine/getContents/readFile/writeFile + 0-arity builtin force (+12 tests, 587/587)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 21s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 21s
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -56,6 +56,8 @@
|
|||||||
(dict-set! v "forced" true)
|
(dict-set! v "forced" true)
|
||||||
(dict-set! v "value" res)
|
(dict-set! v "value" res)
|
||||||
res))))
|
res))))
|
||||||
|
((and (dict? v) (= (get v "type") "builtin") (= (get v "arity") 0))
|
||||||
|
((get v "fn")))
|
||||||
(:else v))))
|
(:else v))))
|
||||||
|
|
||||||
;; Recursive force — used at the test/output boundary so test
|
;; Recursive force — used at the test/output boundary so test
|
||||||
@@ -474,6 +476,16 @@
|
|||||||
((= op "div") (floor (/ lv rv)))
|
((= op "div") (floor (/ lv rv)))
|
||||||
((= op "rem") (mod lv rv))
|
((= op "rem") (mod lv rv))
|
||||||
((= op "quot") (truncate (/ lv rv)))
|
((= op "quot") (truncate (/ lv rv)))
|
||||||
|
((= op ">>=")
|
||||||
|
(if
|
||||||
|
(and (list? lv) (= (first lv) "IO"))
|
||||||
|
(hk-apply rv (nth lv 1))
|
||||||
|
(raise "(>>=): left side is not an IO action")))
|
||||||
|
((= op ">>")
|
||||||
|
(if
|
||||||
|
(and (list? lv) (= (first lv) "IO"))
|
||||||
|
rv
|
||||||
|
(raise "(>>): left side is not an IO action")))
|
||||||
(:else (raise (str "unknown operator: " op))))))
|
(:else (raise (str "unknown operator: " op))))))
|
||||||
|
|
||||||
(define
|
(define
|
||||||
@@ -683,7 +695,7 @@
|
|||||||
(dict-set! env "quot" (hk-make-binop-builtin "quot" "quot"))
|
(dict-set! env "quot" (hk-make-binop-builtin "quot" "quot"))
|
||||||
(dict-set! env "show" (hk-mk-lazy-builtin "show" hk-show-val 1))
|
(dict-set! env "show" (hk-mk-lazy-builtin "show" hk-show-val 1))
|
||||||
(hk-load-into! env hk-prelude-src)
|
(hk-load-into! env hk-prelude-src)
|
||||||
(do
|
(begin
|
||||||
(dict-set!
|
(dict-set!
|
||||||
env
|
env
|
||||||
"putStrLn"
|
"putStrLn"
|
||||||
@@ -691,7 +703,7 @@
|
|||||||
"putStrLn"
|
"putStrLn"
|
||||||
(fn
|
(fn
|
||||||
(s)
|
(s)
|
||||||
(do
|
(begin
|
||||||
(append! hk-io-lines (hk-force s))
|
(append! hk-io-lines (hk-force s))
|
||||||
(list "IO" (list "Tuple"))))
|
(list "IO" (list "Tuple"))))
|
||||||
1))
|
1))
|
||||||
@@ -702,7 +714,7 @@
|
|||||||
"putStr"
|
"putStr"
|
||||||
(fn
|
(fn
|
||||||
(s)
|
(s)
|
||||||
(do
|
(begin
|
||||||
(append! hk-io-lines (hk-force s))
|
(append! hk-io-lines (hk-force s))
|
||||||
(list "IO" (list "Tuple"))))
|
(list "IO" (list "Tuple"))))
|
||||||
1))
|
1))
|
||||||
@@ -713,10 +725,72 @@
|
|||||||
"print"
|
"print"
|
||||||
(fn
|
(fn
|
||||||
(x)
|
(x)
|
||||||
(do
|
(begin
|
||||||
(append! hk-io-lines (hk-show-val x))
|
(append! hk-io-lines (hk-show-val x))
|
||||||
(list "IO" (list "Tuple"))))
|
(list "IO" (list "Tuple"))))
|
||||||
1))
|
1))
|
||||||
|
(dict-set!
|
||||||
|
env
|
||||||
|
"getLine"
|
||||||
|
(hk-mk-lazy-builtin
|
||||||
|
"getLine"
|
||||||
|
(fn
|
||||||
|
()
|
||||||
|
(if
|
||||||
|
(empty? hk-stdin-lines)
|
||||||
|
(error "getLine: no more input")
|
||||||
|
(let
|
||||||
|
((line (first hk-stdin-lines)))
|
||||||
|
(begin
|
||||||
|
(set! hk-stdin-lines (rest hk-stdin-lines))
|
||||||
|
(list "IO" line)))))
|
||||||
|
0))
|
||||||
|
(dict-set!
|
||||||
|
env
|
||||||
|
"getContents"
|
||||||
|
(hk-mk-lazy-builtin
|
||||||
|
"getContents"
|
||||||
|
(fn
|
||||||
|
()
|
||||||
|
(let
|
||||||
|
((lines hk-stdin-lines))
|
||||||
|
(begin
|
||||||
|
(set! hk-stdin-lines (list))
|
||||||
|
(list
|
||||||
|
"IO"
|
||||||
|
(if
|
||||||
|
(empty? lines)
|
||||||
|
""
|
||||||
|
(reduce
|
||||||
|
(fn (acc s) (str acc "\n" s))
|
||||||
|
(first lines)
|
||||||
|
(rest lines)))))))
|
||||||
|
0))
|
||||||
|
(dict-set!
|
||||||
|
env
|
||||||
|
"readFile"
|
||||||
|
(hk-mk-lazy-builtin
|
||||||
|
"readFile"
|
||||||
|
(fn
|
||||||
|
(path)
|
||||||
|
(let
|
||||||
|
((p (hk-force path)))
|
||||||
|
(if
|
||||||
|
(has-key? hk-vfs p)
|
||||||
|
(list "IO" (get hk-vfs p))
|
||||||
|
(error (str "readFile: " p ": file not found")))))
|
||||||
|
1))
|
||||||
|
(dict-set!
|
||||||
|
env
|
||||||
|
"writeFile"
|
||||||
|
(hk-mk-lazy-builtin
|
||||||
|
"writeFile"
|
||||||
|
(fn
|
||||||
|
(path contents)
|
||||||
|
(begin
|
||||||
|
(dict-set! hk-vfs (hk-force path) (hk-force contents))
|
||||||
|
(list "IO" (list "Tuple"))))
|
||||||
|
2))
|
||||||
env))))
|
env))))
|
||||||
|
|
||||||
;; Eagerly build the Prelude env once at load time; each call to
|
;; Eagerly build the Prelude env once at load time; each call to
|
||||||
@@ -945,6 +1019,20 @@
|
|||||||
hk-run-io
|
hk-run-io
|
||||||
(fn (src) (do (set! hk-io-lines (list)) (hk-run src) hk-io-lines)))
|
(fn (src) (do (set! hk-io-lines (list)) (hk-run src) hk-io-lines)))
|
||||||
|
|
||||||
|
(define hk-stdin-lines (list))
|
||||||
|
|
||||||
|
(define hk-vfs (dict))
|
||||||
|
|
||||||
|
(define
|
||||||
|
hk-run-io-with-input
|
||||||
|
(fn
|
||||||
|
(src stdin-lines)
|
||||||
|
(begin
|
||||||
|
(set! hk-io-lines (list))
|
||||||
|
(set! hk-stdin-lines stdin-lines)
|
||||||
|
(hk-run src)
|
||||||
|
hk-io-lines)))
|
||||||
|
|
||||||
(define hk-env0 (hk-init-env))
|
(define hk-env0 (hk-init-env))
|
||||||
|
|
||||||
(define
|
(define
|
||||||
|
|||||||
85
lib/haskell/tests/io-input.sx
Normal file
85
lib/haskell/tests/io-input.sx
Normal file
@@ -0,0 +1,85 @@
|
|||||||
|
;; io-input.sx — tests for getLine, getContents, readFile, writeFile.
|
||||||
|
|
||||||
|
(hk-test
|
||||||
|
"getLine reads single line"
|
||||||
|
(hk-run-io-with-input "main = getLine >>= putStrLn" (list "hello"))
|
||||||
|
(list "hello"))
|
||||||
|
|
||||||
|
(hk-test
|
||||||
|
"getLine reads two lines"
|
||||||
|
(hk-run-io-with-input
|
||||||
|
"main = do { line1 <- getLine; line2 <- getLine; putStrLn line1; putStrLn line2 }"
|
||||||
|
(list "first" "second"))
|
||||||
|
(list "first" "second"))
|
||||||
|
|
||||||
|
(hk-test
|
||||||
|
"getLine bind in layout do"
|
||||||
|
(hk-run-io-with-input
|
||||||
|
"main = do\n line <- getLine\n putStrLn line"
|
||||||
|
(list "world"))
|
||||||
|
(list "world"))
|
||||||
|
|
||||||
|
(hk-test
|
||||||
|
"getLine echo with prefix"
|
||||||
|
(hk-run-io-with-input
|
||||||
|
"main = do\n line <- getLine\n putStrLn (\"Got: \" ++ line)"
|
||||||
|
(list "test"))
|
||||||
|
(list "Got: test"))
|
||||||
|
|
||||||
|
(hk-test
|
||||||
|
"getContents reads all lines joined"
|
||||||
|
(hk-run-io-with-input
|
||||||
|
"main = getContents >>= putStr"
|
||||||
|
(list "line1" "line2" "line3"))
|
||||||
|
(list "line1\nline2\nline3"))
|
||||||
|
|
||||||
|
(hk-test
|
||||||
|
"getContents empty stdin"
|
||||||
|
(hk-run-io-with-input "main = getContents >>= putStr" (list))
|
||||||
|
(list ""))
|
||||||
|
|
||||||
|
(hk-test
|
||||||
|
"readFile reads pre-loaded content"
|
||||||
|
(begin
|
||||||
|
(set! hk-vfs (dict))
|
||||||
|
(dict-set! hk-vfs "hello.txt" "Hello, World!")
|
||||||
|
(hk-run-io "main = readFile \"hello.txt\" >>= putStrLn"))
|
||||||
|
(list "Hello, World!"))
|
||||||
|
|
||||||
|
(hk-test
|
||||||
|
"writeFile creates file"
|
||||||
|
(begin
|
||||||
|
(set! hk-vfs (dict))
|
||||||
|
(hk-run-io "main = writeFile \"out.txt\" \"written content\"")
|
||||||
|
(get hk-vfs "out.txt"))
|
||||||
|
"written content")
|
||||||
|
|
||||||
|
(hk-test
|
||||||
|
"writeFile then readFile roundtrip"
|
||||||
|
(begin
|
||||||
|
(set! hk-vfs (dict))
|
||||||
|
(hk-run-io
|
||||||
|
"main = do { writeFile \"f.txt\" \"round trip\"; readFile \"f.txt\" >>= putStrLn }"))
|
||||||
|
(list "round trip"))
|
||||||
|
|
||||||
|
(hk-test
|
||||||
|
"readFile error on missing file"
|
||||||
|
(guard
|
||||||
|
(e (true (>= (index-of e "file not found") 0)))
|
||||||
|
(begin
|
||||||
|
(set! hk-vfs (dict))
|
||||||
|
(hk-run-io "main = readFile \"no.txt\" >>= putStrLn")
|
||||||
|
false))
|
||||||
|
true)
|
||||||
|
|
||||||
|
(hk-test
|
||||||
|
"getLine then writeFile combined"
|
||||||
|
(begin
|
||||||
|
(set! hk-vfs (dict))
|
||||||
|
(hk-run-io-with-input
|
||||||
|
"main = do\n line <- getLine\n writeFile \"cap.txt\" line"
|
||||||
|
(list "captured"))
|
||||||
|
(get hk-vfs "cap.txt"))
|
||||||
|
"captured")
|
||||||
|
|
||||||
|
{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
|
||||||
@@ -106,7 +106,7 @@ Key mappings:
|
|||||||
|
|
||||||
### Phase 6 — real IO + Prelude completion
|
### Phase 6 — real IO + Prelude completion
|
||||||
- [x] Real `IO` monad backed by `perform`/`resume`
|
- [x] Real `IO` monad backed by `perform`/`resume`
|
||||||
- [ ] `putStrLn`, `getLine`, `readFile`, `writeFile`, `print`
|
- [x] `putStrLn`, `getLine`, `readFile`, `writeFile`, `print`
|
||||||
- [ ] Full-ish Prelude: `Maybe`, `Either`, `List` functions, `Map`-lite
|
- [ ] Full-ish Prelude: `Maybe`, `Either`, `List` functions, `Map`-lite
|
||||||
- [ ] Drive scoreboard toward 150+ passing
|
- [ ] Drive scoreboard toward 150+ passing
|
||||||
|
|
||||||
@@ -114,6 +114,17 @@ Key mappings:
|
|||||||
|
|
||||||
_Newest first._
|
_Newest first._
|
||||||
|
|
||||||
|
- **2026-05-06** — Phase 6 `getLine`/`getContents`/`readFile`/`writeFile`. `hk-force`
|
||||||
|
extended: 0-arity builtins (`arity=0` dicts) are called immediately when forced,
|
||||||
|
making `getLine`/`getContents` work naturally as IO actions (no arity-0 application
|
||||||
|
needed — `>>=` forces them and gets the `("IO" value)` result). `getLine` pops
|
||||||
|
from `hk-stdin-lines`; `getContents` drains it joining with `"\n"`; `readFile`
|
||||||
|
reads from `hk-vfs` (dict), errors on missing key; `writeFile` sets `hk-vfs` key.
|
||||||
|
`hk-run-io-with-input` resets both io-lines and stdin then runs. `>>=` and `>>`
|
||||||
|
added to `hk-binop` for infix operator path. Bug caught: `sx_replace_node` on the
|
||||||
|
thunk-force branch accidentally changed `"body"` → `"fn"` (key name); fixed.
|
||||||
|
11 new tests in `tests/io-input.sx`. 587/587 green.
|
||||||
|
|
||||||
- **2026-05-06** — Phase 6 real IO monad. `eval.sx`: mutable `hk-io-lines` list
|
- **2026-05-06** — Phase 6 real IO monad. `eval.sx`: mutable `hk-io-lines` list
|
||||||
buffer; `putStrLn` and `putStr` append the (forced) string arg; `print` appends
|
buffer; `putStrLn` and `putStr` append the (forced) string arg; `print` appends
|
||||||
`hk-show-val` of the arg; all three return `("IO" ("Tuple"))`. `hk-run-io`
|
`hk-show-val` of the arg; all three return `("IO" ("Tuple"))`. `hk-run-io`
|
||||||
|
|||||||
Reference in New Issue
Block a user