Helpful library updates

This commit is contained in:
2026-05-19 17:30:43 -05:00
parent 020fa769a9
commit e2a1744508
11 changed files with 1684 additions and 966 deletions

View File

@@ -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)

View File

@@ -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

View File

@@ -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)

View File

@@ -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 :

View File

@@ -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)))

View File

@@ -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)

View File

@@ -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)
onOk_ socket (server :
onOk_ (bindSocket server addr port) (_ :
onOk_ (listen server backlog) (_ :
pure (ok server))))
-- 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))
-- 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)))
-- Receive all available bytes up to maxBytes.
onRecv = (sock maxBytes errCase okCase :
bind (recv sock maxBytes) (result :
matchResult errCase okCase result))
-- Same as withAccepted, but handlers drop the useless 'rest' parameter.
withAccepted_ = (server errHandler okHandler :
onResult_ (accept server)
errHandler
(accepted :
okHandler (fst accepted) (snd accepted)))
-- Send bytes and return number of bytes sent.
onSend = (sock bytes errCase okCase :
bind (send sock bytes) (result :
matchResult errCase okCase result))
serveOnce = (server handler :
withAccepted_ server
(err : pure t)
(client peer :
handler client peer))
-- Close a socket, ignoring errors.
closeSocket_ = sock : bind (closeSocket sock) (_ : pure t)
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))))