diff --git a/lib/haskell/eval.sx b/lib/haskell/eval.sx index c71d6622..34b0832d 100644 --- a/lib/haskell/eval.sx +++ b/lib/haskell/eval.sx @@ -56,6 +56,8 @@ (dict-set! v "forced" true) (dict-set! v "value" res) res)))) + ((and (dict? v) (= (get v "type") "builtin") (= (get v "arity") 0)) + ((get v "fn"))) (:else v)))) ;; Recursive force — used at the test/output boundary so test @@ -474,6 +476,16 @@ ((= op "div") (floor (/ lv rv))) ((= op "rem") (mod 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)))))) (define @@ -683,7 +695,7 @@ (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) - (do + (begin (dict-set! env "putStrLn" @@ -691,7 +703,7 @@ "putStrLn" (fn (s) - (do + (begin (append! hk-io-lines (hk-force s)) (list "IO" (list "Tuple")))) 1)) @@ -702,7 +714,7 @@ "putStr" (fn (s) - (do + (begin (append! hk-io-lines (hk-force s)) (list "IO" (list "Tuple")))) 1)) @@ -713,10 +725,72 @@ "print" (fn (x) - (do + (begin (append! hk-io-lines (hk-show-val x)) (list "IO" (list "Tuple")))) 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)))) ;; Eagerly build the Prelude env once at load time; each call to @@ -945,6 +1019,20 @@ hk-run-io (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 diff --git a/lib/haskell/tests/io-input.sx b/lib/haskell/tests/io-input.sx new file mode 100644 index 00000000..71bf4620 --- /dev/null +++ b/lib/haskell/tests/io-input.sx @@ -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} \ No newline at end of file diff --git a/plans/haskell-on-sx.md b/plans/haskell-on-sx.md index 8f730097..b0fcbf20 100644 --- a/plans/haskell-on-sx.md +++ b/plans/haskell-on-sx.md @@ -106,7 +106,7 @@ Key mappings: ### Phase 6 — real IO + Prelude completion - [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 - [ ] Drive scoreboard toward 150+ passing @@ -114,6 +114,17 @@ Key mappings: _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 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`