commit 94ab3412d3b53ab4c12fa18e6c795189486ee476
parent 796c3e8fb273fec5d9cc74168d8d340f682715f2
Author: James Eversole <james@eversole.co>
Date: Tue, 19 May 2026 17:30:43 -0500
Helpful library updates
Diffstat:
| M | demos/interactionTrees/echo-server.tri | | | 60 | +++++++++++++++++++++--------------------------------------- |
| M | lib/base.tri | | | 100 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| M | lib/binary.tri | | | 70 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------------ |
| M | lib/bytes.tri | | | 3 | --- |
| M | lib/conversions.tri | | | 17 | ----------------- |
| M | lib/io.tri | | | 72 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------ |
| M | lib/list.tri | | | 173 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- |
| M | lib/socket.tri | | | 98 | +++++++++++++++++++++++++++++++++++++++++++++++-------------------------------- |
| D | notes/iodriver-updates.md | | | 749 | ------------------------------------------------------------------------------- |
| A | notes/stdlib-todo.md | | | 262 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| M | test/Spec.hs | | | 1052 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-------- |
11 files changed, 1687 insertions(+), 969 deletions(-)
diff --git a/demos/interactionTrees/echo-server.tri b/demos/interactionTrees/echo-server.tri
@@ -2,45 +2,27 @@
!import "../../lib/io.tri" !Local
!import "../../lib/socket.tri" !Local
--- Preserve the host-driver Result shape on error, run okCase on success.
-onOk = action okCase :
- bind action (result :
- matchResult
- (err rest : pure result)
- okCase
- result)
-
--- Convenience: print a string and continue.
-printLn = s : bind (putStr (append s "\n")) (_ : pure t)
-
--- Main accept+echo loop. Recursion via y.
-echoLoop = y (self server :
- bind (accept server) (acceptResult :
- matchResult
- (err rest :
- bind (printLn (append "accept error: " err)) (_ :
- self server))
- (accepted rest :
- matchPair
- (clientSock addr :
- bind (printLn (append "client from " addr)) (_ :
- bind (recv clientSock 4096) (msgResult :
- matchResult
- (err rest :
- bind (closeSocket clientSock) (_ :
- self server))
- (msg rest :
- bind (send clientSock msg) (_ :
- bind (closeSocket clientSock) (_ :
- self server)))
- msgResult)))
- accepted)
- acceptResult))
+-- Main accept+echo loop. Recursion via y.
+echoLoop = y (self : server :
+ withAccepted_ server
+ (err :
+ bind (putStrLn (append "accept error: " err)) (_ :
+ self server))
+ (clientSock addr :
+ bind (putStrLn (append "client from " addr)) (_ :
+ onResult_ (recv clientSock 4096)
+ (err :
+ bind (closeSocket clientSock) (_ :
+ self server))
+ (msg :
+ bind (send clientSock msg) (_ :
+ bind (closeSocket clientSock) (_ :
+ self server))))))
main = io (
- onOk socket (server rest :
- onOk (bindSocket server "127.0.0.1" 0) (_ rest :
- onOk (listen server 5) (_ rest :
- onOk (getSocketName server) (port rest :
- bind (printLn (append "Echo server listening on port " (showNumber port))) (_ :
+ onOk_ socket (server :
+ onOk_ (bindSocket server "127.0.0.1" 0) (_ :
+ onOk_ (listen server 5) (_ :
+ onOk_ (getSocketName server) (port :
+ bind (putStrLn (append "Echo server listening on port " (showNumber port))) (_ :
echoLoop server))))))
diff --git a/lib/base.tri b/lib/base.tri
@@ -33,6 +33,15 @@ lOr = (triage
matchPair = a : triage _ _ a
+fst = p : matchPair (a b : a) p
+snd = p : matchPair (a b : b) p
+
+resultIsOk = result :
+ matchResult (err rest : false) (val rest : true) result
+
+resultIsErr = result :
+ matchResult (err rest : true) (val rest : false) result
+
not? = matchBool false true
and? = matchBool id (_ : false)
@@ -87,3 +96,94 @@ matchResult = (errCase okCase result :
tag)
payload)
result)
+
+-- ---------------------------------------------------------------------------
+-- Maybe / Option type
+-- ---------------------------------------------------------------------------
+
+nothing = t
+just = x : t x
+
+matchMaybe = (nothingCase justCase maybe :
+ triage
+ nothingCase
+ justCase
+ (_ _ : nothingCase)
+ maybe)
+
+maybe = default f m : matchMaybe default f m
+maybeMap = f m : matchMaybe nothing (x : just (f x)) m
+maybeBind = m f : matchMaybe nothing f m
+maybeOr = default m : matchMaybe default id m
+maybe? = matchMaybe false (_ : true)
+
+-- ---------------------------------------------------------------------------
+-- Basic arithmetic
+-- ---------------------------------------------------------------------------
+
+pred = y (self : triage
+ 0
+ (_ : 0)
+ (bit rest :
+ matchBool
+ (matchBool
+ 0
+ (pair 0 rest)
+ (equal? rest 0))
+ (matchBool
+ 0
+ (pair 1 (self rest))
+ (equal? rest 0))
+ bit))
+
+isZero? = triage true (_ : false) (_ _ : false)
+
+add = y (self x y :
+ triage
+ y
+ (_ : succ y)
+ (_ _ : succ (self (pred x) y))
+ x)
+
+sub = y (self a b :
+ matchBool
+ a
+ (self (pred a) (pred b))
+ (isZero? b))
+
+lt? = a b : not? (isZero? (sub b a))
+lte? = a b : isZero? (sub a b)
+
+mul = y (self a b :
+ matchBool
+ 0
+ (add a (self a (pred b)))
+ (isZero? b))
+
+-- ---------------------------------------------------------------------------
+-- Result combinators
+-- ---------------------------------------------------------------------------
+
+mapResult = (f result :
+ matchResult
+ (code rest : err code rest)
+ (value rest : ok (f value) rest)
+ result)
+
+bindResult = (result f :
+ matchResult
+ (code rest : err code rest)
+ (value rest : f value rest)
+ result)
+
+resultOr = (default result :
+ matchResult
+ (_ _ : default)
+ (value _ : value)
+ result)
+
+resultMapErr = (f result :
+ matchResult
+ (code rest : err (f code) rest)
+ (value rest : ok value rest)
+ result)
diff --git a/lib/binary.tri b/lib/binary.tri
@@ -54,19 +54,65 @@ expectU8 = (expected bs :
(byteEq? actual expected))
(readU8 bs))
-mapResult = (f result :
- matchResult
- (code rest : err code rest)
- (value rest : ok (f value) rest)
- result)
-
-bindResult = (result f :
- matchResult
- (code rest : err code rest)
- (value rest : f value rest)
- result)
-
read2 = (bs : readBytes 2 bs)
read4 = (bs : readBytes 4 bs)
readU16BEBytes = (bs : read2 bs)
readU32BEBytes = (bs : read4 bs)
+
+-- ---------------------------------------------------------------------------
+-- Parser combinators
+-- ---------------------------------------------------------------------------
+
+pureParser = value bs : ok value bs
+failParser = code bs : err code bs
+
+mapParser = f p bs : mapResult f (p bs)
+bindParser = p f bs : bindResult (p bs) f
+thenParser = p q bs : bindResult (p bs) (_ : q)
+
+orParser = (p q bs :
+ matchResult
+ (_ _ : q bs)
+ (value rest : ok value rest)
+ (p bs))
+
+readWhile_ = y (self pred bs acc :
+ matchResult
+ (code rest : ok (reverse acc) bs)
+ (value rest :
+ matchBool
+ (self pred rest (pair value acc))
+ (ok (reverse acc) (pair value rest))
+ (pred value))
+ (readU8 bs))
+
+readWhile = pred bs : readWhile_ pred bs t
+
+readUntil = pred : readWhile (x : not? (pred x))
+
+readRemaining = bs : ok bs t
+
+peekU8 = (bs :
+ matchResult
+ (code rest : err code bs)
+ (value rest : ok value bs)
+ (readU8 bs))
+
+eof? = (bs :
+ matchBool
+ (ok t bs)
+ (err errUnexpectedEof bs)
+ (emptyList? bs))
+
+expectAscii = expectBytes
+
+-- ---------------------------------------------------------------------------
+-- Endian / int conversion helpers
+-- ---------------------------------------------------------------------------
+
+u16BE = bytes : add (mul 256 (head bytes)) (head (tail bytes))
+
+u16LE = bytes : add (mul 256 (head (tail bytes))) (head bytes)
+
+readU16BE = bs : bindParser read2 (bytes rest : ok (u16BE bytes) rest) bs
+readU16LE = bs : bindParser read2 (bytes rest : ok (u16LE bytes) rest) bs
diff --git a/lib/bytes.tri b/lib/bytes.tri
@@ -1,9 +1,6 @@
!import "base.tri" !Local
!import "list.tri" !Local
-nothing = t
-just = x : t x
-
bytesNil? = emptyList?
bytesHead = matchList nothing (h _ : just h)
diff --git a/lib/conversions.tri b/lib/conversions.tri
@@ -1,23 +1,6 @@
!import "base.tri" !Local
!import "list.tri" !Local
-pred = y (self : triage
- 0
- (_ : 0)
- (bit rest :
- matchBool
- -- odd: 2n + 1 -> 2n
- (matchBool
- 0
- (pair 0 rest)
- (equal? rest 0))
- -- even: 2n -> 2n - 1
- (matchBool
- 0
- (pair 1 (self rest))
- (equal? rest 0))
- bit))
-
incDecRev = y (self : matchList
"1"
(digit rest :
diff --git a/lib/io.tri b/lib/io.tri
@@ -37,6 +37,55 @@ sleep = ms : pair 63 ms
thenIO = a b : bind a (_ : b)
mapIO = action f : bind action (x : pure (f x))
+void = action : bind action (_ : pure t)
+
+-- ---------------------------------------------------------------------------
+-- Conditional execution
+-- ---------------------------------------------------------------------------
+
+when = cond action : matchBool action (pure t) cond
+unless = cond action : matchBool (pure t) action cond
+
+-- ---------------------------------------------------------------------------
+-- Infinite loop
+-- ---------------------------------------------------------------------------
+
+forever = y (self : action :
+ bind action (_ :
+ self action))
+
+-- ---------------------------------------------------------------------------
+-- Result-aware combinators
+-- ---------------------------------------------------------------------------
+
+-- Propagate driver Result on error; run okCase on success.
+onOk = action okCase :
+ bind action (result :
+ matchResult
+ (err rest : pure result)
+ okCase
+ result)
+
+-- Same as onOk, but the okCase only receives the value (rest is dropped).
+onOk_ = action okCase :
+ bind action (result :
+ matchResult
+ (err rest : pure result)
+ (val _ : okCase val)
+ result)
+
+-- Generalized Result handler with explicit branches.
+onResult = action errCase okCase :
+ bind action (result :
+ matchResult errCase okCase result)
+
+-- Same as onResult, but handlers only receive the value/msg (rest is dropped).
+onResult_ = action errCase okCase :
+ bind action (result :
+ matchResult
+ (err _ : errCase err)
+ (val _ : okCase val)
+ result)
-- ---------------------------------------------------------------------------
-- Convenience helpers
@@ -49,13 +98,9 @@ putStrLn = s : bind (putStr (append s "\n")) (_ : pure t)
-- Result-aware file helpers
-- ---------------------------------------------------------------------------
-onReadFile = (path errCase okCase :
- bind (readFile path) (result :
- matchResult errCase okCase result))
+onReadFile = path : onResult (readFile path)
-onWriteFile = (path contents errCase okCase :
- bind (writeFile path contents) (result :
- matchResult errCase okCase result))
+onWriteFile = path contents : onResult (writeFile path contents)
-- ---------------------------------------------------------------------------
-- Convenience helpers for the common cases
@@ -84,3 +129,18 @@ copyFile = (src dst :
(ok rest : pure t)
wr))
result))
+
+-- ---------------------------------------------------------------------------
+-- Resource-safe combinators
+-- ---------------------------------------------------------------------------
+
+finally = action cleanup :
+ bind action (result :
+ bind cleanup (_ :
+ pure result))
+
+bracket = acquire release use :
+ bind acquire (resource :
+ bind (use resource) (result :
+ bind (release resource) (_ :
+ pure result)))
diff --git a/lib/list.tri b/lib/list.tri
@@ -37,9 +37,13 @@ length = y (self : matchList
0
(_ tail : succ (self tail)))
-reverse = y (self : matchList
- t
- (head tail : append (self tail) (pair head t)))
+reverse_ = y (self xs acc :
+ matchList
+ acc
+ (h r : self r (pair h acc))
+ xs)
+
+reverse = xs : reverse_ xs t
snoc = y (self x : matchList
(pair x t)
@@ -80,3 +84,166 @@ nth_ = y (self n xs i :
xs)
nth = n xs : nth_ n xs 0
+
+headMaybe = matchList nothing (h _ : just h)
+
+lastMaybe = y (self : matchList
+ nothing
+ (hd tl : matchBool
+ (just hd)
+ (self tl)
+ (emptyList? tl)))
+
+nthMaybe_ = y (self n xs i :
+ matchList
+ nothing
+ (h r :
+ matchBool
+ (just h)
+ (self n r (succ i))
+ (equal? i n))
+ xs)
+
+nthMaybe = n xs : nthMaybe_ n xs 0
+
+take_ = y (self n xs i :
+ matchList
+ t
+ (h r :
+ matchBool
+ t
+ (pair h (self n r (succ i)))
+ (equal? i n))
+ xs)
+
+take = n xs : take_ n xs 0
+
+drop_ = y (self n xs i :
+ matchBool
+ xs
+ (matchList
+ t
+ (_ r : self n r (succ i))
+ xs)
+ (equal? i n))
+
+drop = n xs : drop_ n xs 0
+
+splitAt = n xs : pair (take n xs) (drop n xs)
+
+concatMap_ = y (self f xs :
+ matchList
+ t
+ (h r : append (f h) (self f r))
+ xs)
+
+concatMap = f xs : concatMap_ f xs
+
+find = y (self pred xs :
+ matchList
+ nothing
+ (h r : matchBool (just h) (self pred r) (pred h))
+ xs)
+
+partition_ = y (self pred xs trues falses :
+ matchList
+ (pair (reverse trues) (reverse falses))
+ (h r :
+ matchBool
+ (self pred r (pair h trues) falses)
+ (self pred r trues (pair h falses))
+ (pred h))
+ xs)
+
+partition = pred xs : partition_ pred xs t t
+
+partition = pred xs : partition_ pred xs t t
+
+strLength = length
+strAppend = append
+strEq? = equal?
+strEmpty? = emptyList?
+
+startsWith? = y (self prefix str :
+ matchList
+ true
+ (ph pr :
+ matchList
+ false
+ (sh sr :
+ matchBool
+ (self pr sr)
+ false
+ (equal? ph sh))
+ str)
+ prefix)
+
+endsWith? = prefix str : startsWith? (reverse prefix) (reverse str)
+
+contains? = y (self needle haystack :
+ matchBool
+ true
+ (matchList
+ false
+ (_ r : self needle r)
+ haystack)
+ (startsWith? needle haystack))
+
+lines_ = y (self str :
+ matchList
+ (acc current : append acc [(reverse current)])
+ (h r :
+ acc current :
+ matchBool
+ (self r (append acc [(reverse current)]) t)
+ (self r acc (pair h current))
+ (equal? h 10))
+ str)
+
+lines = str : lines_ str t t
+
+unlines = y (self lines :
+ matchList
+ ""
+ (h r : append h (append "\n" (self r)))
+ lines)
+
+words_ = y (self str :
+ matchList
+ (acc current :
+ matchBool
+ acc
+ (append acc [(reverse current)])
+ (emptyList? current))
+ (h r :
+ acc current :
+ matchBool
+ (matchBool
+ (self r acc current)
+ (self r (append acc [(reverse current)]) t)
+ (emptyList? current))
+ (self r acc (pair h current))
+ (equal? h 32))
+ str)
+
+words = str : words_ str t t
+
+unwords = y (self words :
+ matchList
+ ""
+ (h r :
+ matchBool
+ h
+ (append h (append " " (self r)))
+ (emptyList? r))
+ words)
+
+zipWith = y (self f xs ys :
+ matchList
+ t
+ (xh xt :
+ matchList
+ t
+ (yh yt : pair (f xh yh) (self f xt yt))
+ ys)
+ xs)
diff --git a/lib/socket.tri b/lib/socket.tri
@@ -16,48 +16,68 @@ recv = sock maxBytes : pair 76 (pair sock maxBytes)
send = sock bytes : pair 77 (pair sock bytes)
getSocketName = sock : pair 78 sock
--- ---------------------------------------------------------------------------
--- Convenience helpers
--- ---------------------------------------------------------------------------
+-- Result-aware wrappers over raw socket actions.
+onSocket = onResult socket
+onBindSocket = sock addr port : onResult (bindSocket sock addr port)
+onListen = sock backlog : onResult (listen sock backlog)
+onAccept = sock : onResult (accept sock)
+onConnect = sock addr port : onResult (connect sock addr port)
+onRecv = sock maxBytes : onResult (recv sock maxBytes)
+onSend = sock bytes : onResult (send sock bytes)
+onGetSocketName = sock : onResult (getSocketName sock)
-onSocket = (action errCase okCase :
- bind action (result :
- matchResult errCase okCase result))
+-- Result-aware wrappers that drop the useless 'rest' parameter.
+onSocket_ = onResult_ socket
+onBindSocket_ = sock addr port : onResult_ (bindSocket sock addr port)
+onListen_ = sock backlog : onResult_ (listen sock backlog)
+onAccept_ = sock : onResult_ (accept sock)
+onConnect_ = sock addr port : onResult_ (connect sock addr port)
+onRecv_ = sock maxBytes : onResult_ (recv sock maxBytes)
+onSend_ = sock bytes : onResult_ (send sock bytes)
+onGetSocketName_ = sock : onResult_ (getSocketName sock)
+
+-- Close a socket, ignoring errors.
+closeSocket_ = sock : void (closeSocket sock)
-- Create a listening socket bound to an address and port.
-- Returns ok listenSocket or err message.
listenSocket = addr port backlog :
- bind (socket) (result :
- matchResult
- (err rest : pure (err "socket creation failed"))
- (sock rest :
- bind (bindSocket sock addr port) (bindResult :
- matchResult
- (err rest : pure (err "bind failed"))
- (_ rest :
- bind (listen sock backlog) (listenResult :
- matchResult
- (err rest : pure (err "listen failed"))
- (_ rest : pure (ok sock))
- listenResult))
- bindResult))
- result)
-
--- Accept a connection and return (clientSocket, peerAddr).
--- The returned peerAddr is a string like "127.0.0.1:8080".
-onAccept = (sock errCase okCase :
- bind (accept sock) (result :
- matchResult errCase okCase result))
-
--- Receive all available bytes up to maxBytes.
-onRecv = (sock maxBytes errCase okCase :
- bind (recv sock maxBytes) (result :
- matchResult errCase okCase result))
-
--- Send bytes and return number of bytes sent.
-onSend = (sock bytes errCase okCase :
- bind (send sock bytes) (result :
- matchResult errCase okCase result))
+ onOk_ socket (server :
+ onOk_ (bindSocket server addr port) (_ :
+ onOk_ (listen server backlog) (_ :
+ pure (ok server))))
--- Close a socket, ignoring errors.
-closeSocket_ = sock : bind (closeSocket sock) (_ : pure t)
+-- Accept a connection with explicit error and ok branches.
+-- okHandler receives (clientSocket, peerAddr).
+withAccepted = (server errHandler okHandler :
+ onResult (accept server)
+ errHandler
+ (accepted rest :
+ okHandler (fst accepted) (snd accepted)))
+
+-- Same as withAccepted, but handlers drop the useless 'rest' parameter.
+withAccepted_ = (server errHandler okHandler :
+ onResult_ (accept server)
+ errHandler
+ (accepted :
+ okHandler (fst accepted) (snd accepted)))
+
+serveOnce = (server handler :
+ withAccepted_ server
+ (err : pure t)
+ (client peer :
+ handler client peer))
+
+serveForkingOnce = (server handler :
+ withAccepted_ server
+ (err : pure t)
+ (client peer :
+ fork (handler client peer)))
+
+serveForever = (server handler :
+ forever (serveForkingOnce server handler))
+
+connectTo = (addr port :
+ onOk socket (client rest :
+ onOk (connect client addr port) (_ rest :
+ pure (ok client rest))))
diff --git a/notes/iodriver-updates.md b/notes/iodriver-updates.md
@@ -1,749 +0,0 @@
-Below is the implementation handoff for replacing the current recursive/rebuilding IO small-step interpreter with an explicit machine stack, primarily to support `Reader` via `ask` and `local`, while setting up the right shape for eventual async.
-
-## Goal
-
-Refactor `IODriver` from this model:
-
-```haskell
-stepIO :: IOPermissions -> T -> IO Step
-
-data Step
- = Done T
- | Continue T
-```
-
-to an explicit abstract machine:
-
-```haskell
-Machine = Runtime + current action + continuation frames
-```
-
-This is required because `local` is dynamically scoped. It needs to modify the Reader environment for a sub-computation, then restore the previous environment exactly when that sub-computation completes. The current “rebuild `Bind left' k`” approach has nowhere to store that restoration behavior.
-
-This change should support:
-
-```tricu
-ask
-local
-```
-
-now, and keep the structure compatible with future async suspension/resumption.
-
-Do not implement async in this pass.
-
----
-
-## New action tags
-
-Extend the tricu IO action language with Reader tags:
-
-```tricu
-ask = _ : pair 6 t
-local = f action : pair 7 (pair f action)
-```
-
-Host-side:
-
-```haskell
-data Action
- = APure T
- | ABind T T
- | APutStr T
- | AGetLine
- | AReadFile T
- | AWriteFile T T
- | AAsk
- | ALocal T T
- deriving (Show)
-```
-
-Recommended tag allocation:
-
-```text
-0 = pure
-1 = bind
-2 = putStr
-3 = getLine
-4 = readFile
-5 = writeFile
-6 = ask
-7 = local
-```
-
-State tags can come later:
-
-```text
-8 = get
-9 = put
-```
-
-Do not add `bindR`, `bindS`, or `bindRS` yet. Reader is being added as an effect inside the existing IO action language, so the existing IO `bind` remains the only sequencing operator.
-
----
-
-## New runtime model
-
-Add a runtime context:
-
-```haskell
-data Runtime = Runtime
- { rtPerms :: IOPermissions
- , rtEnv :: T
- }
- deriving (Show)
-```
-
-Later this can become:
-
-```haskell
-data Runtime = Runtime
- { rtPerms :: IOPermissions
- , rtEnv :: T
- , rtState :: T
- }
-```
-
-but for this pass, keep it minimal unless State is implemented at the same time.
-
-Add continuation frames:
-
-```haskell
-data Frame
- = BindFrame T
- | LocalFrame T
- deriving (Show)
-```
-
-Frame meanings:
-
-```text
-BindFrame k:
- When the current action produces value x, continue with apply k x.
-
-LocalFrame oldEnv:
- When the current action produces value x, restore oldEnv, then continue with x.
-```
-
-Add the machine state:
-
-```haskell
-data Machine = Machine
- { machineRuntime :: Runtime
- , machineCurrent :: T
- , machineFrames :: [Frame]
- }
- deriving (Show)
-```
-
-Frames should be treated as a stack, with the head as the top:
-
-```haskell
-push frame machine = machine { machineFrames = frame : machineFrames machine }
-```
-
----
-
-## New step result
-
-Replace the current `Step` with machine-oriented stepping:
-
-```haskell
-data Step
- = Halt Runtime T
- | Continue Machine
- deriving (Show)
-```
-
-`Halt runtime value` means the entire IO program is done.
-
-`Continue machine` means the machine can take another step.
-
----
-
-## Core stepping semantics
-
-The central function should become:
-
-```haskell
-stepMachine :: Machine -> IO Step
-```
-
-It should decode `machineCurrent`.
-
-### `pure`
-
-When the current action is `APure value`, do not immediately halt. First inspect the frame stack.
-
-Pseudo-code:
-
-```haskell
-finishValue :: Machine -> T -> IO Step
-finishValue machine value =
- case machineFrames machine of
- [] ->
- pure (Halt (machineRuntime machine) value)
-
- BindFrame k : rest ->
- pure (Continue machine
- { machineCurrent = apply k value
- , machineFrames = rest
- })
-
- LocalFrame oldEnv : rest ->
- let runtime' = (machineRuntime machine) { rtEnv = oldEnv }
- in pure (Continue machine
- { machineRuntime = runtime'
- , machineCurrent = pureAction value
- , machineFrames = rest
- })
-```
-
-You will need a helper:
-
-```haskell
-pureAction :: T -> T
-pureAction x = Fork (ofNumber 0) x
-```
-
-This is important: restoring a `LocalFrame` should not discard the value. It restores the environment and re-enters the machine as `pure value`, allowing the next frame to receive the value.
-
-### `bind`
-
-For:
-
-```haskell
-ABind left k
-```
-
-do not recursively step `left`, and do not rebuild `Bind left' k`.
-
-Instead:
-
-```haskell
-Continue machine
- { machineCurrent = left
- , machineFrames = BindFrame k : machineFrames machine
- }
-```
-
-This is the major refactor. Continuations move out of the tree and into the frame stack.
-
-### `ask`
-
-For:
-
-```haskell
-AAsk
-```
-
-produce the current Reader environment:
-
-```haskell
-finishValue machine (rtEnv (machineRuntime machine))
-```
-
-or equivalently:
-
-```haskell
-Continue machine { machineCurrent = pureAction currentEnv }
-```
-
-Prefer `finishValue` because it avoids an extra step.
-
-### `local`
-
-For:
-
-```haskell
-ALocal f action
-```
-
-do:
-
-```haskell
-let runtime = machineRuntime machine
- oldEnv = rtEnv runtime
- newEnv = apply f oldEnv
- runtime' = runtime { rtEnv = newEnv }
-
-Continue machine
- { machineRuntime = runtime'
- , machineCurrent = action
- , machineFrames = LocalFrame oldEnv : machineFrames machine
- }
-```
-
-This is the central correctness point.
-
-`local` enters a scoped environment by pushing a restoration frame. When the scoped action finishes, `LocalFrame oldEnv` restores the previous environment and passes the produced value onward.
-
-Nested `local` works naturally because frames stack:
-
-```tricu
-local f (
- local g ask
-)
-```
-
-becomes:
-
-```text
-push LocalFrame env0
-set env = f env0
-
-push LocalFrame env1
-set env = g env1
-
-ask returns env2
-
-pop LocalFrame env1
-restore env1
-
-pop LocalFrame env0
-restore env0
-```
-
-### Normal IO actions
-
-For host IO actions, perform the side effect and then call `finishValue`.
-
-Examples:
-
-```haskell
-APutStr str ->
- case decodeString str "PutStr" of
- Right s -> do
- putStr s
- finishValue machine Leaf
- Left _ ->
- finishValue machine (errResult 6)
-```
-
-```haskell
-AReadFile path ->
- case decodeString path "ReadFile" of
- Right p -> do
- result <- ...
- finishValue machine result
- Left _ ->
- finishValue machine (errResult 6)
-```
-
-Important: IO actions should no longer return `Done value` directly. They should return a value to the frame stack via `finishValue`.
-
----
-
-## Decode changes
-
-Extend `decodeAction`:
-
-```haskell
-decodeAction :: T -> Either String Action
-decodeAction tree =
- case tree of
- Fork tag payload ->
- case toNumber tag of
- Right 0 -> Right (APure payload)
-
- Right 1 -> case payload of
- Fork left k -> Right (ABind left k)
- _ -> Left "Invalid Bind: expected pair action continuation"
-
- Right 2 -> Right (APutStr payload)
-
- Right 3 -> Right AGetLine
-
- Right 4 -> Right (AReadFile payload)
-
- Right 5 -> case payload of
- Fork path contents -> Right (AWriteFile path contents)
- _ -> Left "Invalid WriteFile: expected pair path contents"
-
- Right 6 -> Right AAsk
-
- Right 7 -> case payload of
- Fork f action -> Right (ALocal f action)
- _ -> Left "Invalid Local: expected pair function action"
-
- Right n -> Left $ "Unknown IO action tag: " ++ show n
-
- Left err -> Left $ "Invalid action tag: " ++ err
-
- _ ->
- Left $ "Invalid action tree: expected pair tag payload, got " ++ show tree
-```
-
----
-
-## Runner API
-
-Add a new Reader-aware runner:
-
-```haskell
-runIOWithEnv :: IOPermissions -> T -> T -> IO T
-runIOWithEnv perms env action = loop initialMachine
- where
- initialMachine = Machine
- { machineRuntime = Runtime
- { rtPerms = perms
- , rtEnv = env
- }
- , machineCurrent = action
- , machineFrames = []
- }
-
- loop machine = do
- step <- stepMachine machine
- case step of
- Halt _ value -> pure value
- Continue machine' -> loop machine'
-```
-
-Keep the existing API as a compatibility wrapper:
-
-```haskell
-runIO :: IOPermissions -> T -> IO T
-runIO perms action =
- runIOWithEnv perms Leaf action
-```
-
-If State is added in the same branch, prefer:
-
-```haskell
-runIOWith :: IOPermissions -> T -> T -> T -> IO (T, T)
-```
-
-where:
-
-```text
-permissions
-initial reader env
-initial state
-action
-```
-
-returns:
-
-```text
-final result
-final state
-```
-
-But if this handoff is only for Reader, use `runIOWithEnv`.
-
----
-
-## Permission helpers
-
-The current permission helper functions can mostly stay as-is, but they should read permissions from runtime:
-
-```haskell
-let perms = rtPerms (machineRuntime machine)
-```
-
-The current helpers are nested inside `stepIO`. After the refactor, either:
-
-1. keep them in a `where` block under `stepMachine`, or
-2. lift them to top-level helper functions.
-
-Prefer lifting pure/reusable helpers to top-level if this file is getting large:
-
-```haskell
-decodeString :: T -> String -> Either String String
-canonicalizeSafe :: FilePath -> IO (Either String FilePath)
-pathAllowed :: FilePath -> [FilePath] -> IO Bool
-tryReadFile :: FilePath -> IO T
-tryWriteFile :: FilePath -> String -> IO T
-okResult :: T -> T
-errResult :: Integer -> T
-ioErrorCode :: IOException -> Integer
-```
-
-This will make `stepMachine` much easier to read.
-
----
-
-## `io.tri` changes
-
-Add the Reader constructors:
-
-```tricu
-ask = _ : pair 6 t
-local = f action : pair 7 (pair f action)
-```
-
-No new bind is required.
-
-Example usage:
-
-```tricu
-program =
- bind ask (env :
- putStrLn env)
-```
-
-Example `local` usage:
-
-```tricu
-program =
- bind ask (outer :
- bind (local (env : append env "-inner")
- (bind ask (inner :
- pure inner)))
- (result :
- bind ask (after :
- pure result)))
-```
-
-Expected behavior:
-
-```text
-outer ask sees original env
-inner ask sees transformed env
-after ask sees original env again
-```
-
----
-
-## Tests to add
-
-Add tests around behavior, not implementation details.
-
-### 1. `ask` returns initial environment
-
-Program:
-
-```tricu
-io (bind ask (env : pure env))
-```
-
-Run with env:
-
-```text
-"dev"
-```
-
-Expected result:
-
-```text
-"dev"
-```
-
-### 2. `local` transforms environment
-
-Program:
-
-```tricu
-io (
- local (env : append env "-local")
- (bind ask (env : pure env))
-)
-```
-
-Initial env:
-
-```text
-"root"
-```
-
-Expected result:
-
-```text
-"root-local"
-```
-
-### 3. `local` restores environment afterward
-
-Program structure:
-
-```tricu
-bind ask (before :
-bind (local transform scopedAsk) (inside :
-bind ask (after :
-pure (pair before (pair inside after)))))
-```
-
-Initial env:
-
-```text
-"root"
-```
-
-Expected:
-
-```text
-pair "root" (pair "root-local" "root")
-```
-
-### 4. nested `local` composes correctly
-
-Program:
-
-```tricu
-local f (
- local g ask
-)
-```
-
-Initial env:
-
-```text
-"root"
-```
-
-Example:
-
-```tricu
-f = x : append x "-f"
-g = x : append x "-g"
-```
-
-Expected inner ask:
-
-```text
-"root-f-g"
-```
-
-Also verify after both locals, environment is restored by doing a final `ask`.
-
-### 5. `local` result passes through bind correctly
-
-Program:
-
-```tricu
-bind
- (local transform (pure "value"))
- (x : pure x)
-```
-
-Expected:
-
-```text
-"value"
-```
-
-This catches a common bug where `LocalFrame` restores env but loses the value.
-
-### 6. IO still works through bind
-
-Existing IO tests should continue passing unchanged through `runIO`.
-
-### 7. IO inside local
-
-Program:
-
-```tricu
-local transform (
- bind ask (env :
- bind (putStrLn env) (_ :
- pure env))
-)
-```
-
-Expected:
-
-```text
-prints transformed env
-returns transformed env
-```
-
-Then optionally ask after local to verify restoration.
-
----
-
-## Invariants to preserve
-
-The implementation should maintain these invariants:
-
-```text
-1. The current action is always the next instruction to evaluate.
-
-2. The frame stack contains all pending continuations and cleanup scopes.
-
-3. Bind does not recursively step its left side.
- It pushes BindFrame and switches current to the left action.
-
-4. local does not run its action to completion.
- It pushes LocalFrame and switches current to the scoped action.
-
-5. Only LocalFrame restores Reader environment.
-
-6. State, when added later, should not be restored by LocalFrame.
-
-7. Existing runIO behavior remains source-compatible.
-```
-
----
-
-## Common failure modes
-
-The likely bugs are:
-
-```text
-Bug: local leaks environment.
-Cause: setting rtEnv but never restoring it.
-Fix: push LocalFrame oldEnv and restore in finishValue.
-
-Bug: local restores environment but loses result.
-Cause: popping LocalFrame and halting directly.
-Fix: after restoration, continue with pureAction value.
-
-Bug: bind continuations run under the wrong env.
-Cause: LocalFrame and BindFrame pop order is wrong.
-Fix: use stack head as top. Push LocalFrame when entering local; push BindFrame when entering bind. Pop exactly one frame when a value is produced.
-
-Bug: existing IO bind tests fail.
-Cause: IO actions halt instead of passing result to finishValue.
-Fix: every completed primitive action should call finishValue.
-
-Bug: nested binds still rebuild trees.
-Cause: old ABind logic left in place.
-Fix: ABind should only push BindFrame and switch current to left.
-```
-
----
-
-## Async relevance, but not implementation
-
-This machine representation is intentionally compatible with async.
-
-A future scheduler can store:
-
-```haskell
-Machine runtime current frames
-```
-
-when a task blocks, then resume it later by restoring the same `Machine`.
-
-Do not implement any of these now:
-
-```haskell
-AFork
-AAwait
-ASleep
-TaskId
-Scheduler
-Runnable queue
-Blocked table
-```
-
-But avoid designs that would make future suspension impossible, especially recursive “run sub-computation to completion” implementations of `local`. The point of the frame machine is that every effect remains small-step and resumable.
-
----
-
-## Recommended implementation order
-
-1. Add `Runtime`, `Frame`, and `Machine`.
-2. Add `pureAction`.
-3. Replace `Step` with `Halt Runtime T | Continue Machine`.
-4. Implement `finishValue`.
-5. Rewrite `ABind` to push `BindFrame`.
-6. Rewrite existing primitive IO actions to call `finishValue`.
-7. Add `AAsk` and `ALocal`.
-8. Add `runIOWithEnv`.
-9. Rewrite `runIO` as a wrapper.
-10. Add `ask` and `local` to `io.tri`.
-11. Add Reader behavior tests.
-12. Run all existing IO tests and confirm no regressions.
-
-The key handoff instruction is: implement `local` as a continuation frame, not as a recursive nested run. This keeps the interpreter genuinely small-step and gives the eventual async runtime the exact representation it will need for suspension and resumption.
diff --git a/notes/stdlib-todo.md b/notes/stdlib-todo.md
@@ -0,0 +1,262 @@
+# Standard Library TODO / Expansion Plan
+
+> Foundational expansions that improve safety, composability, and ergonomics across the entire tricu ecosystem.
+
+---
+
+## 1. Extract a `maybe.tri` / Option layer
+
+**Motivation:** `head`, `tail`, `last`, `nth`, `bytesHead`, and `bytesTail` currently return `t` on failure, which is ambiguous because `t` is also a valid tree value. A proper option layer makes all of these APIs safer and self-describing.
+
+**Additions:**
+
+```tricu
+nothing = t
+just = x : t x
+
+matchMaybe = nothingCase justCase maybe :
+ triage
+ nothingCase
+ justCase
+ (_ _ : nothingCase)
+ maybe
+
+maybe = default f m : matchMaybe default f m
+maybeMap = f m : matchMaybe nothing (x : just (f x)) m
+maybeBind = m f : matchMaybe nothing f m
+maybeOr = default m : matchMaybe default id m
+maybe? = matchMaybe false (_ : true)
+```
+
+**Then update existing list/bytes primitives:**
+
+```tricu
+headMaybe
+lastMaybe
+nthMaybe
+bytesHead
+bytesTail
+```
+
+---
+
+## 2. Move `Result` combinators from `binary.tri` into `base.tri`
+
+**Motivation:** `Result` is defined in `base.tri`, but `mapResult` and `bindResult` currently live in `binary.tri`. This makes them unavailable to IO, socket, and file helpers unless every consumer imports binary parsing.
+
+**Move / add to `base.tri`:**
+
+```tricu
+mapResult = f result :
+ matchResult
+ (code rest : err code rest)
+ (value rest : ok (f value) rest)
+ result
+
+bindResult = result f :
+ matchResult
+ (code rest : err code rest)
+ (value rest : f value rest)
+ result
+
+resultOr = default result :
+ matchResult
+ (_ _ : default)
+ (value _ : value)
+ result
+
+resultMapErr = f result :
+ matchResult
+ (code rest : err (f code) rest)
+ (value rest : ok value rest)
+ result
+```
+
+---
+
+## 3. Add basic numeric comparison and arithmetic
+
+**Motivation:** Without comparison and arithmetic, list slicing, parser limits, counters, socket loops, and CLI utilities are awkward or impossible.
+
+**Priority order:**
+
+1. `isZero?`
+2. `add`
+3. `sub`
+4. `lt?`
+5. `lte?`
+6. `mul`
+
+Even simple Peano / binary-tree versions unlock a huge amount of functionality.
+
+---
+
+## 4. Expand `list.tri` with safer and more complete primitives
+
+**Motivation:** `reverse` currently uses `append` recursively, which is quadratic. Many common operations (`take`, `drop`, `concatMap`) are missing entirely.
+
+**High-impact additions:**
+
+```tricu
+take
+drop
+splitAt
+concatMap
+find
+partition
+zipWith
+```
+
+**Performance fix:**
+
+```tricu
+reverse_ = y (self xs acc :
+ matchList
+ acc
+ (h r : self r (pair h acc))
+ xs)
+
+reverse = xs : reverse_ xs t
+```
+
+This is low-effort, high-impact because `reverse` is already used by `binary.tri` and `conversions.tri`.
+
+---
+
+## 5. Add string aliases / helpers
+
+**Motivation:** IO and CLI programs almost always need line/string manipulation. Socket protocols are also easier with canonical string utilities.
+
+**Highest value:**
+
+```tricu
+startsWith?
+contains?
+lines
+unlines
+```
+
+Also consider:
+
+```tricu
+strLength
+strAppend
+strEq?
+strEmpty?
+words
+unwords
+endsWith?
+```
+
+---
+
+## 6. Expand `binary.tri` into a small parser-combinator layer
+
+**Motivation:** `binary.tri` already has `readU8`, `readBytes`, `expectBytes`, etc. A thin combinator layer makes binary parsing much more ergonomic and reusable for protocols/file formats.
+
+**Suggested additions:**
+
+```tricu
+pureParser = value bs : ok value bs
+failParser = code bs : err code bs
+
+mapParser = mapResult
+bindParser = bindResult
+thenParser = p q : bindResult p (_ : q)
+orParser = p q bs :
+ matchResult
+ (_ _ : q bs)
+ (value rest : ok value rest)
+ (p bs)
+```
+
+Then common parsers:
+
+```tricu
+readWhile
+readUntil
+readRemaining
+peekU8
+eof?
+expectAscii
+```
+
+---
+
+## 7. Add endian / int conversion helpers
+
+**Motivation:** `readU16BEBytes` and `readU32BEBytes` return raw byte lists. Either rename them or add actual numeric decoding.
+
+**Suggested additions:**
+
+```tricu
+u16BE
+u16LE
+u32BE
+u32LE
+
+readU16BE
+readU16LE
+readU32BE
+readU32LE
+```
+
+---
+
+## 8. Add resource-safe IO helpers
+
+**Motivation:** Sockets, files, and process-like resources need predictable cleanup.
+
+```tricu
+finally = action cleanup :
+ bind action (result :
+ bind cleanup (_ :
+ pure result))
+
+bracket = acquire release use :
+ bind acquire (resource :
+ bind (use resource) (result :
+ bind (release resource) (_ :
+ pure result)))
+```
+
+---
+
+## 9. Add socket server loops
+
+**Motivation:** Almost every socket example repeats the same `forever` + `withAccepted_` scaffolding.
+
+```tricu
+serveForever = server handler :
+ forever
+ (withAccepted_ server
+ (err : pure t)
+ (client peer :
+ fork (handler client peer)))
+```
+
+Also consider:
+
+```tricu
+connectTo = addr port :
+ onOk_ socket (client :
+ onOk_ (connect client addr port) (_ :
+ pure (ok client)))
+```
+
+---
+
+## 10. Add a curated `prelude.tri`
+
+**Motivation:** As libraries grow, users need a stable starting point.
+
+```tricu
+!import "base.tri" !Local
+!import "maybe.tri" !Local
+!import "list.tri" !Local
+!import "bytes.tri" !Local
+!import "conversions.tri" !Local
+```
+
+This gives a standard baseline without importing IO / socket / binary by default.
+
diff --git a/test/Spec.hs b/test/Spec.hs
@@ -45,6 +45,7 @@ tests = testGroup "Tricu Tests"
, simpleEvaluation
, lambdas
, providedLibraries
+ , maybeTests
, fileEval
, modules
, demos
@@ -55,6 +56,7 @@ tests = testGroup "Tricu Tests"
, wireTests
, tricuReaderTests
, byteListUtilities
+ , binaryParserTests
, ioDriverTests
]
@@ -490,6 +492,93 @@ lambdas = testGroup "Lambda Evaluation Tests"
tricuTestString input @?= "Fork (Fork (Stem Leaf) Leaf) Leaf"
]
+maybeTests :: TestTree
+maybeTests = testGroup "Maybe Tests"
+ [ testCase "nothing is Leaf" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "nothing"
+ env = evalTricu base (parseTricu input)
+ result env @?= Leaf
+
+ , testCase "just wraps value in Stem" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "just (t t)"
+ env = evalTricu base (parseTricu input)
+ result env @?= Stem (Stem Leaf)
+
+ , testCase "matchMaybe on nothing returns default" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "matchMaybe \"empty\" (x : x) nothing"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofString "empty"
+
+ , testCase "matchMaybe on just extracts value" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "matchMaybe \"empty\" (x : x) (just (t t))"
+ env = evalTricu base (parseTricu input)
+ result env @?= Stem Leaf
+
+ , testCase "maybe applies f inside just" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "maybe 0 (x : succ x) (just 5)"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 6
+
+ , testCase "maybe returns default on nothing" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "maybe 0 (x : succ x) nothing"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 0
+
+ , testCase "maybeMap transforms just value" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "maybeMap (x : succ x) (just 3)"
+ env = evalTricu base (parseTricu input)
+ result env @?= justT (ofNumber 4)
+
+ , testCase "maybeMap returns nothing on nothing" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "maybeMap (x : succ x) nothing"
+ env = evalTricu base (parseTricu input)
+ result env @?= nothingT
+
+ , testCase "maybeBind flattens just" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "maybeBind (just 3) (x : just (succ x))"
+ env = evalTricu base (parseTricu input)
+ result env @?= justT (ofNumber 4)
+
+ , testCase "maybeBind returns nothing on nothing" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "maybeBind nothing (x : just (succ x))"
+ env = evalTricu base (parseTricu input)
+ result env @?= Leaf
+
+ , testCase "maybeOr returns just value" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "maybeOr 99 (just 5)"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 5
+
+ , testCase "maybeOr returns default on nothing" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "maybeOr 99 nothing"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 99
+
+ , testCase "maybe? on just is true" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "maybe? (just t)"
+ env = evalTricu base (parseTricu input)
+ result env @?= trueT
+
+ , testCase "maybe? on nothing is false" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "maybe? nothing"
+ env = evalTricu base (parseTricu input)
+ result env @?= falseT
+ ]
+
providedLibraries :: TestTree
providedLibraries = testGroup "Library Tests"
[ testCase "Triage test Leaf" $ do
@@ -588,6 +677,561 @@ providedLibraries = testGroup "Library Tests"
let input = "equal? (t t t) (t t t)"
env = evalTricu library (parseTricu input)
result env @?= Stem Leaf
+
+ , testCase "headMaybe on empty list" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "headMaybe []"
+ env = evalTricu library (parseTricu input)
+ result env @?= nothingT
+
+ , testCase "headMaybe on non-empty list" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "headMaybe [(t) (t t)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= justT Leaf
+
+ , testCase "lastMaybe on empty list" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "lastMaybe []"
+ env = evalTricu library (parseTricu input)
+ result env @?= nothingT
+
+ , testCase "lastMaybe on single element" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "lastMaybe [(t t)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= justT (Stem Leaf)
+
+ , testCase "lastMaybe on multi-element list" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "lastMaybe [(t) (t t) (t t t)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= justT (Fork Leaf Leaf)
+
+ , testCase "nthMaybe first element" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "nthMaybe 0 [(t) (t t)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= justT Leaf
+
+ , testCase "nthMaybe middle element" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "nthMaybe 1 [(t) (t t) (t t t)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= justT (Stem Leaf)
+
+ , testCase "nthMaybe out of bounds" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "nthMaybe 5 [(t) (t t)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= nothingT
+
+ , testCase "reverse empty list" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "reverse []"
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList []
+
+ , testCase "reverse non-empty list" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "reverse [(1) (2) (3)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList [ofNumber 3, ofNumber 2, ofNumber 1]
+
+ , testCase "take 0 any list = empty" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "take 0 [(1) (2) (3)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList []
+
+ , testCase "take 2 [1,2,3] = [1,2]" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "take 2 [(1) (2) (3)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList [ofNumber 1, ofNumber 2]
+
+ , testCase "take overlong returns whole list" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "take 5 [(1) (2)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList [ofNumber 1, ofNumber 2]
+
+ , testCase "drop 0 any list = list" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "drop 0 [(1) (2) (3)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList [ofNumber 1, ofNumber 2, ofNumber 3]
+
+ , testCase "drop 2 [1,2,3] = [3]" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "drop 2 [(1) (2) (3)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList [ofNumber 3]
+
+ , testCase "drop overlong returns empty" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "drop 5 [(1) (2)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList []
+
+ , testCase "splitAt 0 [1,2] = pair [] [1,2]" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "splitAt 0 [(1) (2)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= pairT (ofList []) (ofList [ofNumber 1, ofNumber 2])
+
+ , testCase "splitAt 2 [1,2,3] = pair [1,2] [3]" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "splitAt 2 [(1) (2) (3)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= pairT (ofList [ofNumber 1, ofNumber 2]) (ofList [ofNumber 3])
+
+ , testCase "splitAt overlong = pair [1,2] []" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "splitAt 5 [(1) (2)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= pairT (ofList [ofNumber 1, ofNumber 2]) (ofList [])
+
+ , testCase "concatMap on empty list" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "concatMap (x : [(x) (x)]) []"
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList []
+
+ , testCase "concatMap doubles elements" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "concatMap (x : [(x) (x)]) [(1) (2)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList [ofNumber 1, ofNumber 1, ofNumber 2, ofNumber 2]
+
+ , testCase "find on empty list" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "find (x : equal? x 2) []"
+ env = evalTricu library (parseTricu input)
+ result env @?= nothingT
+
+ , testCase "find finds element" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "find (x : equal? x 2) [(1) (2) (3)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= justT (ofNumber 2)
+
+ , testCase "find missing element" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "find (x : equal? x 9) [(1) (2) (3)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= nothingT
+
+ , testCase "partition empty list" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "partition (x : equal? x 2) []"
+ env = evalTricu library (parseTricu input)
+ result env @?= pairT (ofList []) (ofList [])
+
+ , testCase "partition splits list" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "partition (x : lt? 2 x) [(1) (2) (3) (4)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= pairT (ofList [ofNumber 3, ofNumber 4]) (ofList [ofNumber 1, ofNumber 2])
+
+ , testCase "zipWith on empty lists" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "zipWith add [] []"
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList []
+
+ , testCase "zipWith adds pairwise" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "zipWith add [(1) (2)] [(10) (20)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList [ofNumber 11, ofNumber 22]
+
+ , testCase "zipWith truncates to shorter list" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "zipWith add [(1) (2)] [(10)]"
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList [ofNumber 11]
+
+ , testCase "strLength" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "strLength \"hello\""
+ env = evalTricu library (parseTricu input)
+ result env @?= ofNumber 5
+
+ , testCase "strAppend" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "strAppend \"hello\" \" world\""
+ env = evalTricu library (parseTricu input)
+ result env @?= ofString "hello world"
+
+ , testCase "strEq? equal strings" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "strEq? \"abc\" \"abc\""
+ env = evalTricu library (parseTricu input)
+ result env @?= trueT
+
+ , testCase "strEq? different strings" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "strEq? \"abc\" \"def\""
+ env = evalTricu library (parseTricu input)
+ result env @?= falseT
+
+ , testCase "strEmpty? on empty" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "strEmpty? \"\""
+ env = evalTricu library (parseTricu input)
+ result env @?= trueT
+
+ , testCase "strEmpty? on non-empty" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "strEmpty? \"a\""
+ env = evalTricu library (parseTricu input)
+ result env @?= falseT
+
+ , testCase "startsWith? prefix matches" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "startsWith? \"he\" \"hello\""
+ env = evalTricu library (parseTricu input)
+ result env @?= trueT
+
+ , testCase "startsWith? prefix too long" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "startsWith? \"hello\" \"he\""
+ env = evalTricu library (parseTricu input)
+ result env @?= falseT
+
+ , testCase "startsWith? empty prefix" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "startsWith? \"\" \"hello\""
+ env = evalTricu library (parseTricu input)
+ result env @?= trueT
+
+ , testCase "endsWith? suffix matches" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "endsWith? \"lo\" \"hello\""
+ env = evalTricu library (parseTricu input)
+ result env @?= trueT
+
+ , testCase "endsWith? suffix too long" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "endsWith? \"hello\" \"lo\""
+ env = evalTricu library (parseTricu input)
+ result env @?= falseT
+
+ , testCase "endsWith? empty suffix" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "endsWith? \"\" \"hello\""
+ env = evalTricu library (parseTricu input)
+ result env @?= trueT
+
+ , testCase "contains? substring found" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "contains? \"ell\" \"hello\""
+ env = evalTricu library (parseTricu input)
+ result env @?= trueT
+
+ , testCase "contains? substring missing" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "contains? \"xyz\" \"hello\""
+ env = evalTricu library (parseTricu input)
+ result env @?= falseT
+
+ , testCase "contains? empty needle" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "contains? \"\" \"hello\""
+ env = evalTricu library (parseTricu input)
+ result env @?= trueT
+
+ , testCase "lines splits on newline" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "lines \"a\\nb\\nc\""
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList [ofString "a", ofString "b", ofString "c"]
+
+ , testCase "lines single line" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "lines \"hello\""
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList [ofString "hello"]
+
+ , testCase "lines empty string" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "lines \"\""
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList [ofString ""]
+
+ , testCase "lines trailing newline" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "lines \"a\\n\""
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList [ofString "a", ofString ""]
+
+ , testCase "unlines joins with newline" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "unlines [(\"a\") (\"b\")]"
+ env = evalTricu library (parseTricu input)
+ result env @?= ofString "a\nb\n"
+
+ , testCase "unlines empty list" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "unlines []"
+ env = evalTricu library (parseTricu input)
+ result env @?= ofString ""
+
+ , testCase "words splits on space" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "words \"hello world\""
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList [ofString "hello", ofString "world"]
+
+ , testCase "words empty string" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "words \"\""
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList []
+
+ , testCase "words multiple spaces" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "words \" hello world \""
+ env = evalTricu library (parseTricu input)
+ result env @?= ofList [ofString "hello", ofString "world"]
+
+ , testCase "unwords joins with space" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "unwords [(\"hello\") (\"world\")]"
+ env = evalTricu library (parseTricu input)
+ result env @?= ofString "hello world"
+
+ , testCase "unwords single word" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "unwords [(\"hello\")]"
+ env = evalTricu library (parseTricu input)
+ result env @?= ofString "hello"
+
+ , testCase "unwords empty list" $ do
+ library <- evaluateFile "./lib/list.tri"
+ let input = "unwords []"
+ env = evalTricu library (parseTricu input)
+ result env @?= ofString ""
+ ]
+
+arithmeticTests :: TestTree
+arithmeticTests = testGroup "Arithmetic Tests"
+ [ testCase "isZero? on 0" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "isZero? 0"
+ env = evalTricu base (parseTricu input)
+ result env @?= trueT
+
+ , testCase "isZero? on 5" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "isZero? 5"
+ env = evalTricu base (parseTricu input)
+ result env @?= falseT
+
+ , testCase "add 0 3 = 3" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "add 0 3"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 3
+
+ , testCase "add 3 0 = 3" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "add 3 0"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 3
+
+ , testCase "add 2 3 = 5" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "add 2 3"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 5
+
+ , testCase "sub 5 2 = 3" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "sub 5 2"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 3
+
+ , testCase "sub 2 5 = 0 (saturated)" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "sub 2 5"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 0
+
+ , testCase "sub 5 5 = 0" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "sub 5 5"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 0
+
+ , testCase "lt? 2 3 = true" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "lt? 2 3"
+ env = evalTricu base (parseTricu input)
+ result env @?= trueT
+
+ , testCase "lt? 3 2 = false" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "lt? 3 2"
+ env = evalTricu base (parseTricu input)
+ result env @?= falseT
+
+ , testCase "lt? 2 2 = false" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "lt? 2 2"
+ env = evalTricu base (parseTricu input)
+ result env @?= falseT
+
+ , testCase "lte? 2 3 = true" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "lte? 2 3"
+ env = evalTricu base (parseTricu input)
+ result env @?= trueT
+
+ , testCase "lte? 3 2 = false" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "lte? 3 2"
+ env = evalTricu base (parseTricu input)
+ result env @?= falseT
+
+ , testCase "lte? 2 2 = true" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "lte? 2 2"
+ env = evalTricu base (parseTricu input)
+ result env @?= trueT
+
+ , testCase "mul 0 5 = 0" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "mul 0 5"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 0
+
+ , testCase "mul 5 0 = 0" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "mul 5 0"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 0
+
+ , testCase "mul 2 3 = 6" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "mul 2 3"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 6
+
+ , testCase "mul 3 3 = 9" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "mul 3 3"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 9
+
+ , testCase "pred 0 = 0" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "pred 0"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 0
+
+ , testCase "pred 1 = 0" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "pred 1"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 0
+
+ , testCase "pred 5 = 4" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "pred 5"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 4
+
+ , testCase "add is commutative" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "equal? (add 4 7) (add 7 4)"
+ env = evalTricu base (parseTricu input)
+ result env @?= trueT
+
+ , testCase "add is associative" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "equal? (add (add 2 3) 4) (add 2 (add 3 4))"
+ env = evalTricu base (parseTricu input)
+ result env @?= trueT
+
+ , testCase "sub x 0 = x" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "sub 7 0"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 7
+
+ , testCase "sub chained" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "sub (sub 10 3) 2"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 5
+
+ , testCase "mul identity 1" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "mul 1 5"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 5
+
+ , testCase "mul identity 2" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "mul 5 1"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 5
+
+ , testCase "mul is commutative" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "equal? (mul 3 4) (mul 4 3)"
+ env = evalTricu base (parseTricu input)
+ result env @?= trueT
+
+ , testCase "mul is associative" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "equal? (mul (mul 2 3) 4) (mul 2 (mul 3 4))"
+ env = evalTricu base (parseTricu input)
+ result env @?= trueT
+
+ , testCase "mul distributes over add" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "equal? (mul 2 (add 3 4)) (add (mul 2 3) (mul 2 4))"
+ env = evalTricu base (parseTricu input)
+ result env @?= trueT
+
+ , testCase "lt? reflexive is false" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "lt? 5 5"
+ env = evalTricu base (parseTricu input)
+ result env @?= falseT
+
+ , testCase "lte? reflexive is true" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "lte? 5 5"
+ env = evalTricu base (parseTricu input)
+ result env @?= trueT
+
+ , testCase "lt? transitivity" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "and? (lt? 2 5) (lt? 5 7)"
+ env = evalTricu base (parseTricu input)
+ result env @?= trueT
+
+ , testCase "add larger numbers" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "add 12 15"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 27
+
+ , testCase "mul larger numbers" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "mul 5 6"
+ env = evalTricu base (parseTricu input)
+ result env @?= ofNumber 30
+
+ , testCase "isZero? on add 0 0" $ do
+ base <- evaluateFile "./lib/base.tri"
+ let input = "isZero? (add 0 0)"
+ env = evalTricu base (parseTricu input)
+ result env @?= trueT
]
fileEval :: TestTree
@@ -1365,6 +2009,157 @@ byteListUtilities = testGroup "Byte List Utility Tests"
]
-- --------------------------------------------------------------------------
+-- Binary parser combinator tests
+-- --------------------------------------------------------------------------
+
+parserOk :: T -> T -> T
+parserOk val rest = Fork trueT (Fork val rest)
+
+parserErr :: T -> T -> T
+parserErr code rest = Fork falseT (Fork code rest)
+
+binaryParserTests :: TestTree
+binaryParserTests = testGroup "Binary Parser Tests"
+ [ testCase "pureParser succeeds" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "pureParser 42 [(1) (2)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserOk (ofNumber 42) (bytesT [1, 2])
+
+ , testCase "failParser fails" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "failParser 99 [(1) (2)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserErr (ofNumber 99) (bytesT [1, 2])
+
+ , testCase "mapParser transforms value" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "mapParser succ readU8 [(1) (2)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserOk (ofNumber 2) (bytesT [2])
+
+ , testCase "bindParser chains parsers" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "bindParser readU8 (x : readU8) [(1) (2)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserOk (ofNumber 2) (bytesT [])
+
+ , testCase "thenParser discards first result" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "thenParser readU8 readU8 [(1) (2)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserOk (ofNumber 2) (bytesT [])
+
+ , testCase "orParser tries second on first failure" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "orParser (failParser 1) readU8 [(5)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserOk (ofNumber 5) (bytesT [])
+
+ , testCase "orParser returns first on success" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "orParser readU8 (failParser 1) [(5)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserOk (ofNumber 5) (bytesT [])
+
+ , testCase "readWhile consumes matching bytes" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "readWhile (x : lt? x 3) [(1) (2) (3) (4)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserOk (bytesT [1, 2]) (bytesT [3, 4])
+
+ , testCase "readWhile leaves non-matching byte" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "bindParser (readWhile (x : lt? x 3)) (x : readU8) [(1) (2) (3)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserOk (ofNumber 3) (bytesT [])
+
+ , testCase "readUntil stops at matching byte" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "readUntil (x : equal? x 3) [(1) (2) (3) (4)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserOk (bytesT [1, 2]) (bytesT [3, 4])
+
+ , testCase "readRemaining returns all bytes" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "readRemaining [(1) (2) (3)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserOk (bytesT [1, 2, 3]) (bytesT [])
+
+ , testCase "peekU8 does not consume" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "bindParser peekU8 (x : readU8) [(7) (8)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserOk (ofNumber 7) (bytesT [8])
+
+ , testCase "peekU8 second read gets same byte" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "bindParser peekU8 (x : bindParser peekU8 (y : pureParser (pair x y))) [(7)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserOk (pairT (ofNumber 7) (ofNumber 7)) (bytesT [7])
+
+ , testCase "eof? succeeds at empty input" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "eof? []"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserOk Leaf (bytesT [])
+
+ , testCase "eof? fails on non-empty input" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "eof? [(1)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserErr (ofNumber 1) (bytesT [1])
+
+ , testCase "expectAscii matches string" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "expectAscii \"hi\" [(104) (105) (106)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserOk Leaf (bytesT [106])
+
+ , testCase "expectAscii fails on mismatch" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "expectAscii \"hi\" [(104) (99)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserErr (ofNumber 2) (bytesT [104, 99])
+
+ , testCase "u16BE decodes big-endian" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "u16BE [(1) (0)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= ofNumber 256
+
+ , testCase "u16BE zero" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "u16BE [(0) (1)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= ofNumber 1
+
+ , testCase "u16LE decodes little-endian" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "u16LE [(1) (0)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= ofNumber 1
+
+ , testCase "u16LE zero" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "u16LE [(0) (1)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= ofNumber 256
+
+ , testCase "readU16BE parses and decodes" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "readU16BE [(0) (1) (2)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserOk (ofNumber 1) (bytesT [2])
+
+ , testCase "readU16LE parses and decodes" $ do
+ lib <- evaluateFile "./lib/binary.tri"
+ let input = "readU16LE [(1) (0) (2)]"
+ env = evalTricu lib (parseTricu input)
+ result env @?= parserOk (ofNumber 1) (bytesT [2])
+ ]
+
+-- --------------------------------------------------------------------------
-- IO driver tests
-- --------------------------------------------------------------------------
@@ -1930,18 +2725,18 @@ ioDriverTests = testGroup "IO driver tests"
final @?= ioErrResult "invalid socket handle"
, testCase "bindSocket and listen succeed on loopback port 0" $ do
- final <- runIOSource "main = io (bind socket (result : matchResult (err rest : pure result) (sock rest : bind (bindSocket sock \"127.0.0.1\" 0) (bindResult : matchResult (err rest : pure bindResult) (_ rest : bind (listen sock 1) (listenResult : pure listenResult)) bindResult)) result))"
- final @?= ioOkResult Leaf
-
- , testCase "connect to non-listening port returns error" $ do
final <- runIOSource $
unlines
- [ "main = io (bind socket (result :"
- , " matchResult"
- , " (err rest : pure \"socket-err\")"
- , " (sock rest : connect sock \"127.0.0.1\" 1)"
- , " result))"
+ [ "main = io ("
+ , " onOk socket (server rest :"
+ , " onOk (bindSocket server \"127.0.0.1\" 0) (_ rest :"
+ , " bind (listen server 1) (listenResult :"
+ , " pure listenResult))))"
]
+ final @?= ioOkResult Leaf
+
+ , testCase "connect to non-listening port returns error" $ do
+ final <- runIOSource "main = io (onOk socket (sock rest : connect sock \"127.0.0.1\" 1))"
case final of
Fork Leaf (Fork _ Leaf) -> return ()
other -> assertFailure $ "Expected error result, got: " ++ show other
@@ -1950,32 +2745,18 @@ ioDriverTests = testGroup "IO driver tests"
withFreePort $ \port -> do
final <- runIOSource $
unlines
- [ "preserveResult = (result okCase :"
- , " matchResult"
- , " (err rest : pure result)"
- , " okCase"
- , " result)"
- , ""
- , "client = port :"
- , " bind socket (result :"
- , " preserveResult result (sock rest :"
- , " bind (connect sock \"127.0.0.1\" port) (connectResult :"
- , " preserveResult connectResult (_ rest :"
- , " send sock [104 105]))))"
+ [ "client = port :"
+ , " onOk socket (sock rest :"
+ , " onOk (connect sock \"127.0.0.1\" port) (_ rest :"
+ , " send sock [104 105]))"
, ""
, "main = io ("
- , " bind socket (result :"
- , " preserveResult result (server rest :"
- , " bind (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (bindResult :"
- , " preserveResult bindResult (_ rest :"
- , " bind (listen server 1) (listenResult :"
- , " preserveResult listenResult (_ rest :"
- , " bind (fork (client " ++ show port ++ ")) (_ :"
- , " bind (accept server) (acceptResult :"
- , " preserveResult acceptResult (accepted rest :"
- , " matchPair"
- , " (clientSock addr : recv clientSock 2)"
- , " accepted))))))))))"
+ , " onOk socket (server rest :"
+ , " onOk (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (_ rest :"
+ , " onOk (listen server 1) (_ rest :"
+ , " bind (fork (client " ++ show port ++ ")) (_ :"
+ , " onOk (accept server) (accepted rest :"
+ , " recv (fst accepted) 2))))))"
]
final @?= ioOkResult (ofBytes (BS.pack [104, 105]))
@@ -1983,39 +2764,23 @@ ioDriverTests = testGroup "IO driver tests"
withFreePort $ \port -> do
final <- runIOSource $
unlines
- [ "preserveResult = (result okCase :"
- , " matchResult"
- , " (err rest : pure result)"
- , " okCase"
- , " result)"
- , ""
- , "serverTask = server :"
- , " bind (accept server) (acceptResult :"
- , " preserveResult acceptResult (accepted rest :"
- , " matchPair"
- , " (clientSock addr :"
- , " bind (recv clientSock 4) (msgResult :"
- , " preserveResult msgResult (_ rest :"
- , " send clientSock [112 111 110 103])))"
- , " accepted))"
+ [ "serverTask = (server :"
+ , " onOk (accept server) (accepted rest :"
+ , " onOk (recv (fst accepted) 4) (msg rest :"
+ , " send (fst accepted) [112 111 110 103])))"
, ""
- , "clientTask = port :"
- , " bind socket (result :"
- , " preserveResult result (sock rest :"
- , " bind (connect sock \"127.0.0.1\" port) (connectResult :"
- , " preserveResult connectResult (_ rest :"
- , " bind (send sock [112 105 110 103]) (_ :"
- , " recv sock 4)))))"
+ , "clientTask = (port :"
+ , " onOk socket (sock rest :"
+ , " onOk (connect sock \"127.0.0.1\" port) (_ rest :"
+ , " bind (send sock [112 105 110 103]) (_ :"
+ , " recv sock 4))))"
, ""
, "main = io ("
- , " bind socket (result :"
- , " preserveResult result (server rest :"
- , " bind (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (bindResult :"
- , " preserveResult bindResult (_ rest :"
- , " bind (listen server 1) (listenResult :"
- , " preserveResult listenResult (_ rest :"
- , " bind (fork (serverTask server)) (_ :"
- , " clientTask " ++ show port ++ "))))))))"
+ , " onOk socket (server rest :"
+ , " onOk (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (_ rest :"
+ , " onOk (listen server 1) (_ rest :"
+ , " bind (fork (serverTask server)) (_ :"
+ , " clientTask " ++ show port ++ ")))))"
]
final @?= ioOkResult (ofBytes (BS.pack [112, 111, 110, 103]))
@@ -2023,34 +2788,19 @@ ioDriverTests = testGroup "IO driver tests"
withFreePort $ \port -> do
final <- runIOSource $
unlines
- [ "preserveResult = (result okCase :"
- , " matchResult"
- , " (err rest : pure result)"
- , " okCase"
- , " result)"
- , ""
- , "clientTask = port :"
- , " bind socket (result :"
- , " preserveResult result (sock rest :"
- , " bind (connect sock \"127.0.0.1\" port) (connectResult :"
- , " preserveResult connectResult (_ rest :"
- , " closeSocket sock))))"
+ [ "clientTask = port :"
+ , " onOk socket (sock rest :"
+ , " onOk (connect sock \"127.0.0.1\" port) (_ rest :"
+ , " closeSocket sock))"
, ""
, "main = io ("
- , " bind socket (result :"
- , " preserveResult result (server rest :"
- , " bind (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (bindResult :"
- , " preserveResult bindResult (_ rest :"
- , " bind (listen server 1) (listenResult :"
- , " preserveResult listenResult (_ rest :"
- , " bind (fork (clientTask " ++ show port ++ ")) (_ :"
- , " bind (accept server) (acceptResult :"
- , " preserveResult acceptResult (accepted rest :"
- , " matchPair"
- , " (clientSock addr :"
- , " bind (yield) (_ :"
- , " recv clientSock 1))"
- , " accepted))))))))))"
+ , " onOk socket (server rest :"
+ , " onOk (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (_ rest :"
+ , " onOk (listen server 1) (_ rest :"
+ , " bind (fork (clientTask " ++ show port ++ ")) (_ :"
+ , " onOk (accept server) (accepted rest :"
+ , " bind (yield) (_ :"
+ , " recv (fst accepted) 1)))))))"
]
final @?= ioErrResult "connection closed"
@@ -2069,18 +2819,11 @@ ioDriverTests = testGroup "IO driver tests"
, testCase "getSocketName returns positive port after bind 0" $ do
final <- runIOSource $
unlines
- [ "preserveResult = (result okCase :"
- , " matchResult"
- , " (err rest : pure result)"
- , " okCase"
- , " result)"
- , ""
- , "main = io ("
- , " bind socket (result :"
- , " preserveResult result (server rest :"
- , " bind (bindSocket server \"127.0.0.1\" 0) (bindResult :"
- , " preserveResult bindResult (_ rest :"
- , " getSocketName server)))))"
+ [ "main = io ("
+ , " onOk socket (server rest :"
+ , " onOk (bindSocket server \"127.0.0.1\" 0) (_ rest :"
+ , " bind (getSocketName server) (nameResult :"
+ , " pure nameResult))))"
]
case final of
Fork (Stem Leaf) (Fork val Leaf) ->
@@ -2089,6 +2832,113 @@ ioDriverTests = testGroup "IO driver tests"
Right 0 -> assertFailure "Expected positive port, got 0"
Left _ -> assertFailure $ "Expected numeric port, got: " ++ show val
other -> assertFailure $ "Expected ok result, got: " ++ show other
+
+ , testCase "connectTo creates connected socket" $
+ withFreePort $ \port -> do
+ final <- runIOSource $
+ unlines
+ [ "clientTask = port :"
+ , " onOk (connectTo \"127.0.0.1\" port) (client rest :"
+ , " onOk (send client [104 105]) (_ rest :"
+ , " pure t))"
+ , ""
+ , "main = io ("
+ , " onOk socket (server rest :"
+ , " onOk (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (_ rest :"
+ , " onOk (listen server 1) (_ rest :"
+ , " bind (fork (clientTask " ++ show port ++ ")) (_ :"
+ , " onOk (accept server) (accepted rest :"
+ , " onOk (recv (fst accepted) 2) (msg rest :"
+ , " pure msg)))))))"
+ ]
+ final @?= ofBytes (BS.pack [104, 105])
+
+ , testCase "serveOnce handles a single client connection" $
+ withFreePort $ \port -> do
+ final <- runIOSource $
+ unlines
+ [ "echoHandler = (client peer :"
+ , " onOk (recv client 2) (msg rest :"
+ , " onOk (send client msg) (_ rest :"
+ , " pure t)))"
+ , ""
+ , "clientTask = (port :"
+ , " onOk socket (sock rest :"
+ , " onOk (connect sock \"127.0.0.1\" port) (_ rest :"
+ , " onOk (send sock [104 105]) (_ rest :"
+ , " onOk (recv sock 2) (msg rest :"
+ , " pure msg)))))"
+ , ""
+ , "main = io ("
+ , " onOk socket (server rest :"
+ , " onOk (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (_ rest :"
+ , " onOk (listen server 1) (_ rest :"
+ , " bind (fork (serveOnce server echoHandler)) (_ :"
+ , " clientTask " ++ show port ++ ")))))"
+ ]
+ final @?= ofBytes (BS.pack [104, 105])
+
+ , testCase "finally preserves successful action result" $ do
+ final <- runIOSource $
+ unlines
+ [ "main = io (finally (pure 42) (pure 99))"
+ ]
+ final @?= ofNumber 42
+
+ , testCase "finally runs cleanup after successful action" $
+ withSystemTempDirectory "tricu-finally" $ \dir -> do
+ let cleanupPath = dir ++ "/cleanup.txt"
+ final <- runIOSource $
+ unlines
+ [ "main = io (finally"
+ , " (pure 42)"
+ , " (writeFile \"" ++ cleanupPath ++ "\" \"cleaned\"))"
+ ]
+ final @?= ofNumber 42
+ contents <- readFile cleanupPath
+ contents @?= "cleaned"
+
+ , testCase "bracket passes acquired resource to use" $ do
+ final <- runIOSource $
+ unlines
+ [ "main = io (bracket (pure 41) (_ : pure t) (r : pure (succ r)))"
+ ]
+ final @?= ofNumber 42
+
+ , testCase "bracket preserves successful use result over release result" $ do
+ final <- runIOSource $
+ unlines
+ [ "main = io (bracket (pure \"res\") (_ : pure 123) (_ : pure 99))"
+ ]
+ final @?= ofNumber 99
+
+ , testCase "bracket runs release on successful use" $
+ withSystemTempDirectory "tricu-bracket" $ \dir -> do
+ let releasePath = dir ++ "/release.txt"
+ final <- runIOSource $
+ unlines
+ [ "main = io (bracket"
+ , " (pure \"" ++ releasePath ++ "\")"
+ , " (path : writeFile path \"released\")"
+ , " (path : pure 99))"
+ ]
+ final @?= ofNumber 99
+ contents <- readFile releasePath
+ contents @?= "released"
+
+ , testCase "bracket passes acquired resource to release" $
+ withSystemTempDirectory "tricu-bracket-release-resource" $ \dir -> do
+ let releasePath = dir ++ "/release.txt"
+ final <- runIOSource $
+ unlines
+ [ "main = io (bracket"
+ , " (pure \"" ++ releasePath ++ "\")"
+ , " (path : writeFile path \"released\")"
+ , " (_ : pure 99))"
+ ]
+ final @?= ofNumber 99
+ contents <- readFile releasePath
+ contents @?= "released"
]
]
