Helpful library updates
This commit is contained in:
100
lib/base.tri
100
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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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 :
|
||||
|
||||
72
lib/io.tri
72
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)))
|
||||
|
||||
173
lib/list.tri
173
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)
|
||||
|
||||
@@ -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))))
|
||||
|
||||
Reference in New Issue
Block a user