James Eversole
2e2db07bd6
+ let bindings + where bindings + do notation I explored enough of the alternative language design space and decided that we should commit fully to Lambda style. That means no more highly tacit/concatenative point-free/partial programs as default. We'll keep taking advantage of those capabilities when it makes sense, but the library will continue to see massive overhauls.
112 lines
2.4 KiB
Plaintext
112 lines
2.4 KiB
Plaintext
!import "base.tri" !Local
|
|
!import "list.tri" !Local
|
|
!import "bytes.tri" !Local
|
|
|
|
errUnexpectedEof = 1
|
|
errUnexpectedBytes = 2
|
|
errUnexpectedByte = 3
|
|
|
|
unit = t
|
|
|
|
readU8 = (bytes :
|
|
matchList
|
|
(err errUnexpectedEof t)
|
|
(h r : ok h r)
|
|
bytes)
|
|
|
|
readBytes_ self bs n i original acc =
|
|
matchList
|
|
(matchBool
|
|
(ok (reverse acc) bs)
|
|
(err errUnexpectedEof original)
|
|
(equal? i n))
|
|
(h r :
|
|
matchBool
|
|
(ok (reverse acc) bs)
|
|
(self r n (succ i) original (pair h acc))
|
|
(equal? i n))
|
|
bs
|
|
|
|
readBytes = (n bs :
|
|
y readBytes_ bs n 0 bs t)
|
|
|
|
expectBytes_ self expected bs original =
|
|
matchList
|
|
(ok unit bs)
|
|
(expectedByte expectedRest :
|
|
matchResult
|
|
(code rest : err code original)
|
|
(actual rest :
|
|
matchBool
|
|
(self expectedRest rest original)
|
|
(err errUnexpectedBytes original)
|
|
(equal? actual expectedByte))
|
|
(readU8 bs))
|
|
expected
|
|
|
|
expectBytes = (expected bs :
|
|
y expectBytes_ expected bs bs)
|
|
|
|
expectU8 = (expected bs :
|
|
matchResult
|
|
(code rest : err code bs)
|
|
(actual rest :
|
|
matchBool
|
|
(ok unit rest)
|
|
(err errUnexpectedByte bs)
|
|
(equal? actual expected))
|
|
(readU8 bs))
|
|
|
|
read2 = (bs : readBytes 2 bs)
|
|
read4 = (bs : readBytes 4 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_ 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 :
|
|
y 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
|