tricu

An interpreted language for exploring Tree Calculus
Log | Files | Refs | README | LICENSE

binary.tri (2354B)

      1 !import "prelude" !Local
      2 
      3 errUnexpectedEof = 1
      4 errUnexpectedBytes = 2
      5 errUnexpectedByte = 3
      6 
      7 unit = t
      8 
      9 readU8 = (bytes :
     10   matchList
     11     (err errUnexpectedEof t)
     12     (h r : ok h r)
     13     bytes)
     14 
     15 readBytes_ self bs n i original acc =
     16   matchList
     17     (matchBool
     18       (ok (reverse acc) bs)
     19       (err errUnexpectedEof original)
     20       (equal? i n))
     21     (h r :
     22       matchBool
     23         (ok (reverse acc) bs)
     24         (self r n (succ i) original (pair h acc))
     25         (equal? i n))
     26     bs
     27 
     28 readBytes = (n bs :
     29   y readBytes_ bs n 0 bs t)
     30 
     31 expectBytes_ self expected bs original =
     32   matchList
     33     (ok unit bs)
     34     (expectedByte expectedRest :
     35       matchResult
     36         (code rest : err code original)
     37         (actual rest :
     38           matchBool
     39             (self expectedRest rest original)
     40             (err errUnexpectedBytes original)
     41             (equal? actual expectedByte))
     42         (readU8 bs))
     43     expected
     44 
     45 expectBytes = (expected bs :
     46   y expectBytes_ expected bs bs)
     47 
     48 expectU8 = (expected bs :
     49   matchResult
     50     (code rest : err code bs)
     51     (actual rest :
     52       matchBool
     53         (ok unit rest)
     54         (err errUnexpectedByte bs)
     55         (equal? actual expected))
     56     (readU8 bs))
     57 
     58 read2 = (bs : readBytes 2 bs)
     59 read4 = (bs : readBytes 4 bs)
     60 readU32BEBytes = (bs : read4 bs)
     61 
     62 -- ---------------------------------------------------------------------------
     63 -- Parser combinators
     64 -- ---------------------------------------------------------------------------
     65 
     66 pureParser = value bs : ok value bs
     67 failParser = code bs : err code bs
     68 
     69 mapParser = f p bs : mapResult f (p bs)
     70 bindParser = p f bs : bindResult (p bs) f
     71 thenParser = p q bs : bindResult (p bs) (_ : q)
     72 
     73 orParser = (p q bs :
     74   matchResult
     75     (_ _ : q bs)
     76     (value rest : ok value rest)
     77     (p bs))
     78 
     79 readWhile_ self pred bs acc =
     80   matchResult
     81     (code rest : ok (reverse acc) bs)
     82     (value rest :
     83       matchBool
     84         (self pred rest (pair value acc))
     85         (ok (reverse acc) (pair value rest))
     86         (pred value))
     87     (readU8 bs)
     88 
     89 readWhile = pred bs :
     90   y readWhile_ pred bs t
     91 
     92 readUntil = pred :
     93   readWhile (x : not? (pred x))
     94 
     95 readRemaining = bs : ok bs t
     96 
     97 peekU8 = (bs :
     98   matchResult
     99     (code rest : err code bs)
    100     (value rest : ok value bs)
    101     (readU8 bs))
    102 
    103 eof? = (bs :
    104   matchBool
    105     (ok t bs)
    106     (err errUnexpectedEof bs)
    107     (emptyList? bs))
    108 
    109 expectAscii = expectBytes