tricu

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

d1367d8434ccbe04394aadac46fbde74af0412699d85e361faec63e2c9417b03.tri (9502B)

      1 !import prelude *
      2 !export *
      3 
      4 -- Finite-stream parser protocol. Keep this module independent of token codecs.
      5 -- Reply = pair status (pair payload (pair rest (pair consumed committed)))
      6 -- status is true for success; payload is value or diagnostic respectively.
      7 -- Flags are relative to this parser invocation. A diagnostic may itself carry
      8 -- a location; rollback never changes that location.
      9 -- Diagnostic = pair code (pair expected (pair found (pair location contexts))).
     10 -- A field of t denotes unspecified information; contexts is a list from the
     11 -- outermost context to the innermost. Source/byte adapters supply locations.
     12 parserDiagnostic code expected found location contexts =
     13   pair code (pair expected (pair found (pair location contexts)))
     14 
     15 parserDiagnosticCode diagnostic = fst diagnostic
     16 parserDiagnosticExpected diagnostic = fst (snd diagnostic)
     17 parserDiagnosticFound diagnostic = fst (snd (snd diagnostic))
     18 parserDiagnosticLocation diagnostic = fst (snd (snd (snd diagnostic)))
     19 parserDiagnosticContexts diagnostic = snd (snd (snd (snd diagnostic)))
     20 
     21 parserDiagnosticWithExpected label diagnostic =
     22   parserDiagnostic (parserDiagnosticCode diagnostic) label
     23     (parserDiagnosticFound diagnostic) (parserDiagnosticLocation diagnostic)
     24     (parserDiagnosticContexts diagnostic)
     25 
     26 parserDiagnosticWithContext context diagnostic =
     27   parserDiagnostic (parserDiagnosticCode diagnostic)
     28     (parserDiagnosticExpected diagnostic) (parserDiagnosticFound diagnostic)
     29     (parserDiagnosticLocation diagnostic)
     30     (pair context (parserDiagnosticContexts diagnostic))
     31 
     32 parserReplyOk value rest consumed committed =
     33   pair true (pair value (pair rest (pair consumed committed)))
     34 
     35 parserReplyFail diagnostic rest consumed committed =
     36   pair false (pair diagnostic (pair rest (pair consumed committed)))
     37 
     38 parserReplyPayload reply = fst (snd reply)
     39 parserReplyRest reply = fst (snd (snd reply))
     40 parserReplyConsumed reply = fst (snd (snd (snd reply)))
     41 parserReplyCommitted reply = snd (snd (snd (snd reply)))
     42 
     43 -- The branch handlers take payload, remainder, consumed, committed.
     44 parserMatchReply failK okK reply =
     45   lazyBool
     46     (_ : okK (parserReplyPayload reply) (parserReplyRest reply)
     47              (parserReplyConsumed reply) (parserReplyCommitted reply))
     48     (_ : failK (parserReplyPayload reply) (parserReplyRest reply)
     49                (parserReplyConsumed reply) (parserReplyCommitted reply))
     50     (fst reply)
     51 
     52 parserPure value input = parserReplyOk value input false false
     53 parserFailure diagnostic input = parserReplyFail diagnostic input false false
     54 parserCommit input = parserReplyOk t input false true
     55 
     56 parserMap f parser input =
     57   parserMatchReply
     58     (diagnostic rest consumed committed :
     59       parserReplyFail diagnostic rest consumed committed)
     60     (value rest consumed committed :
     61       parserReplyOk (f value) rest consumed committed)
     62     (parser input)
     63 
     64 parserBind parser next input =
     65   parserMatchReply
     66     (diagnostic rest consumed committed :
     67       parserReplyFail diagnostic rest consumed committed)
     68     (value rest consumed committed :
     69       parserMatchReply
     70         (diagnostic2 rest2 consumed2 committed2 :
     71           parserReplyFail diagnostic2 rest2
     72             (or? consumed consumed2) (or? committed committed2))
     73         (value2 rest2 consumed2 committed2 :
     74           parserReplyOk value2 rest2
     75             (or? consumed consumed2) (or? committed committed2))
     76         (next value rest))
     77     (parser input)
     78 
     79 parserThen first second = parserBind first (_ : second)
     80 parserBefore first second = parserBind first (value : parserMap (_ : value) second)
     81 
     82 -- Compose a character lexer and a token parser without discarding either
     83 -- failure's original remainder. Successful lexing contributes consumption.
     84 parserWithLexer lexer grammar characters =
     85   parserMatchReply
     86     (diagnostic rest consumed committed :
     87       parserReplyFail diagnostic rest consumed committed)
     88     (tokens rest consumed committed :
     89       parserMatchReply
     90         (diagnostic2 tokensRest consumed2 committed2 :
     91           parserReplyFail diagnostic2 tokensRest
     92             (or? consumed consumed2) (or? committed committed2))
     93         (value tokensRest consumed2 committed2 :
     94           parserReplyOk value tokensRest
     95             (or? consumed consumed2) (or? committed committed2))
     96         (grammar tokens))
     97     (lexer characters)
     98 parserApply functionParser valueParser =
     99   parserBind functionParser (f : parserMap f valueParser)
    100 
    101 parserOr left right input =
    102   parserMatchReply
    103     (diagnostic rest consumed committed :
    104       lazyBool
    105         (_ : parserReplyFail diagnostic rest consumed committed)
    106         (_ : right input)
    107         (or? consumed committed))
    108     (value rest consumed committed :
    109       parserReplyOk value rest consumed committed)
    110     (left input)
    111 
    112 parserLabel label parser input =
    113   parserMatchReply
    114     (diagnostic rest consumed committed :
    115       parserReplyFail (parserDiagnosticWithExpected label diagnostic)
    116         rest consumed committed)
    117     (value rest consumed committed :
    118       parserReplyOk value rest consumed committed)
    119     (parser input)
    120 
    121 parserContext context parser input =
    122   parserMatchReply
    123     (diagnostic rest consumed committed :
    124       parserReplyFail (parserDiagnosticWithContext context diagnostic)
    125         rest consumed committed)
    126     (value rest consumed committed :
    127       parserReplyOk value rest consumed committed)
    128     (parser input)
    129 
    130 parserAttempt parser input =
    131   parserMatchReply
    132     (diagnostic rest consumed committed :
    133       parserReplyFail diagnostic input false false)
    134     (value rest consumed committed :
    135       parserReplyOk value rest consumed committed)
    136     (parser input)
    137 
    138 parserUnexpectedEof = parserDiagnostic 1 t t t t
    139 parserUnexpectedToken token = parserDiagnostic 2 t token t t
    140 
    141 parserAny input =
    142   lazyList
    143     (_ : parserReplyFail parserUnexpectedEof input false false)
    144     (head rest : parserReplyOk head rest true false)
    145     input
    146 
    147 parserSatisfy predicate input =
    148   parserMatchReply
    149     (diagnostic rest consumed committed :
    150       parserReplyFail diagnostic rest consumed committed)
    151     (value rest consumed committed :
    152       lazyBool
    153         (_ : parserReplyOk value rest true false)
    154         (_ : parserReplyFail (parserUnexpectedToken value) input false false)
    155         (predicate value))
    156     (parserAny input)
    157 
    158 parserExpect token =
    159   parserLabel token (parserSatisfy (value : equal? token value))
    160 
    161 parserPeek input =
    162   parserMatchReply
    163     (diagnostic rest consumed committed :
    164       parserReplyFail diagnostic input false false)
    165     (value rest consumed committed :
    166       parserReplyOk value input false false)
    167     (parserAny input)
    168 
    169 parserEof input =
    170   lazyList
    171     (_ : parserReplyOk t input false false)
    172     (head rest : parserReplyFail (parserUnexpectedToken head) input false false)
    173     input
    174 
    175 parserOptional parser =
    176   parserOr (parserMap just parser) (parserPure nothing)
    177 
    178 parserNonConsumingRepetition = parserDiagnostic 3 t t t t
    179 
    180 -- The worker's first runtime argument is the stream. An iteration may only
    181 -- recur after actual consumption, never merely because it committed. Build the
    182 -- result backwards with constant-time cons, reversing only at the stopping
    183 -- branch. Failure after progress retains that progress and the failing suffix.
    184 parserMany_ self input parser acc consumed committed =
    185   parserMatchReply
    186     (diagnostic rest stepConsumed stepCommitted :
    187       lazyBool
    188         (_ : parserReplyFail diagnostic rest
    189                (or? consumed stepConsumed) (or? committed stepCommitted))
    190         (_ : parserReplyOk (reverse acc) input consumed committed)
    191         (or? stepConsumed stepCommitted))
    192     (value rest stepConsumed stepCommitted :
    193       lazyBool
    194         (_ : self rest parser (pair value acc)
    195                true (or? committed stepCommitted))
    196         (_ : parserReplyFail parserNonConsumingRepetition input
    197                consumed (or? committed stepCommitted))
    198         stepConsumed)
    199     (parser input)
    200 
    201 parserMany parser input = y parserMany_ input parser t false false
    202 parserSome parser =
    203   parserBind parser (first :
    204     parserMap (rest : pair first rest) (parserMany parser))
    205 
    206 parserTakeWhile predicate = parserMany (parserSatisfy predicate)
    207 parserTakeWhile1 predicate = parserSome (parserSatisfy predicate)
    208 
    209 parserBetween open content close =
    210   parserThen open (parserBefore content close)
    211 
    212 -- A separator consumes and commits its following element on failure; callers
    213 -- who want a trailing separator must express that rule explicitly.
    214 parserSepBy1 element separator =
    215   parserBind element (first :
    216     parserMap (rest : pair first rest)
    217       (parserMany (parserThen separator element)))
    218 
    219 -- Choice for an empty sequence applies only to the *first element*. Once
    220 -- that element succeeds, a later zero-width or committed failure must not be
    221 -- hidden by falling back to the empty sequence.
    222 parserSepBy element separator input =
    223   parserMatchReply
    224     (diagnostic rest consumed committed :
    225       lazyBool
    226         (_ : parserReplyFail diagnostic rest consumed committed)
    227         (_ : parserReplyOk t input false false)
    228         (or? consumed committed))
    229     (first rest consumed committed :
    230       parserMatchReply
    231         (diagnostic2 rest2 consumed2 committed2 :
    232           parserReplyFail diagnostic2 rest2
    233             (or? consumed consumed2) (or? committed committed2))
    234         (tail rest2 consumed2 committed2 :
    235           parserReplyOk (pair first tail) rest2
    236             (or? consumed consumed2) (or? committed committed2))
    237         (parserMany (parserThen separator element) rest))
    238     (element input)
    239