tricu

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

parser.tri (8922B)

      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 -- Match only the status projection. Destructuring the whole reply here would
     44 -- demand fields a handler may ignore. Every non-Leaf status remains truthy.
     45 parserMatchReply failK okK reply = case (fst reply) of
     46   t = failK (parserReplyPayload reply) (parserReplyRest reply) (parserReplyConsumed reply) (parserReplyCommitted reply)
     47   _ = okK (parserReplyPayload reply) (parserReplyRest reply) (parserReplyConsumed reply) (parserReplyCommitted reply)
     48 
     49 parserPure value input = parserReplyOk value input false false
     50 parserFailure diagnostic input = parserReplyFail diagnostic input false false
     51 parserCommit input = parserReplyOk t input false true
     52 
     53 parserMap f parser input =
     54   parserMatchReply
     55     (diagnostic rest consumed committed :
     56       parserReplyFail diagnostic rest consumed committed)
     57     (value rest consumed committed :
     58       parserReplyOk (f value) rest consumed committed)
     59     (parser input)
     60 
     61 -- Merge progress without changing payload, remainder or diagnostic location.
     62 parserMergeFlags consumed committed reply = (parserMatchReply
     63   (diagnostic rest nextConsumed nextCommitted :
     64     parserReplyFail diagnostic rest (or? consumed nextConsumed) (or? committed nextCommitted))
     65   (value rest nextConsumed nextCommitted :
     66     parserReplyOk value rest (or? consumed nextConsumed) (or? committed nextCommitted))
     67   reply)
     68 
     69 parserBind parser next input = (parserMatchReply
     70   parserReplyFail
     71   (value rest consumed committed : parserMergeFlags consumed committed (next value rest))
     72   (parser input))
     73 
     74 parserThen first second = parserBind first (_ : second)
     75 parserBefore first second = parserBind first (value : parserMap (_ : value) second)
     76 
     77 -- Compose a character lexer and a token parser without discarding either
     78 -- failure's original remainder. Successful lexing contributes consumption.
     79 parserWithLexer lexer grammar characters = (parserMatchReply
     80   parserReplyFail
     81   (tokens rest consumed committed : parserMergeFlags consumed committed (grammar tokens))
     82   (lexer characters))
     83 
     84 parserApply functionParser valueParser =
     85   parserBind functionParser (f : parserMap f valueParser)
     86 
     87 parserOr left right input =
     88   parserMatchReply
     89     (diagnostic rest consumed committed :
     90       lazyBool
     91         (_ : parserReplyFail diagnostic rest consumed committed)
     92         (_ : right input)
     93         (or? consumed committed))
     94     (value rest consumed committed :
     95       parserReplyOk value rest consumed committed)
     96     (left input)
     97 
     98 parserLabel label parser input =
     99   parserMatchReply
    100     (diagnostic rest consumed committed :
    101       parserReplyFail (parserDiagnosticWithExpected label diagnostic)
    102         rest consumed committed)
    103     (value rest consumed committed :
    104       parserReplyOk value rest consumed committed)
    105     (parser input)
    106 
    107 parserContext context parser input =
    108   parserMatchReply
    109     (diagnostic rest consumed committed :
    110       parserReplyFail (parserDiagnosticWithContext context diagnostic)
    111         rest consumed committed)
    112     (value rest consumed committed :
    113       parserReplyOk value rest consumed committed)
    114     (parser input)
    115 
    116 parserAttempt parser input =
    117   parserMatchReply
    118     (diagnostic rest consumed committed :
    119       parserReplyFail diagnostic input false false)
    120     (value rest consumed committed :
    121       parserReplyOk value rest consumed committed)
    122     (parser input)
    123 
    124 parserUnexpectedEof = parserDiagnostic 1 t t t t
    125 parserUnexpectedToken token = parserDiagnostic 2 t token t t
    126 
    127 parserAny input =
    128   lazyList
    129     (_ : parserReplyFail parserUnexpectedEof input false false)
    130     (head rest : parserReplyOk head rest true false)
    131     input
    132 
    133 parserSatisfy predicate input =
    134   parserMatchReply
    135     (diagnostic rest consumed committed :
    136       parserReplyFail diagnostic rest consumed committed)
    137     (value rest consumed committed :
    138       lazyBool
    139         (_ : parserReplyOk value rest true false)
    140         (_ : parserReplyFail (parserUnexpectedToken value) input false false)
    141         (predicate value))
    142     (parserAny input)
    143 
    144 parserExpect token =
    145   parserLabel token (parserSatisfy (value : equal? token value))
    146 
    147 parserPeek input =
    148   parserMatchReply
    149     (diagnostic rest consumed committed :
    150       parserReplyFail diagnostic input false false)
    151     (value rest consumed committed :
    152       parserReplyOk value input false false)
    153     (parserAny input)
    154 
    155 parserEof input =
    156   lazyList
    157     (_ : parserReplyOk t input false false)
    158     (head rest : parserReplyFail (parserUnexpectedToken head) input false false)
    159     input
    160 
    161 parserOptional parser =
    162   parserOr (parserMap just parser) (parserPure nothing)
    163 
    164 parserNonConsumingRepetition = parserDiagnostic 3 t t t t
    165 
    166 -- Capture the parser once; only stream, reversed values and progress vary.
    167 -- Recur only after consumption, never merely because a step committed.
    168 parserMany parser input = (let rec
    169   scan stream acc consumed committed = (parserMatchReply
    170     (diagnostic rest stepConsumed stepCommitted :
    171       case (or? stepConsumed stepCommitted) of
    172         t = parserReplyOk (reverse acc) stream consumed committed
    173         _ = parserReplyFail diagnostic rest (or? consumed stepConsumed) (or? committed stepCommitted))
    174     (value rest stepConsumed stepCommitted :
    175       case stepConsumed of
    176         t = parserReplyFail parserNonConsumingRepetition stream consumed (or? committed stepCommitted)
    177         _ = scan rest (pair value acc) true (or? committed stepCommitted))
    178     (parser stream))
    179   in scan input t false false)
    180 
    181 parserSome parser =
    182   parserBind parser (first :
    183     parserMap (rest : pair first rest) (parserMany parser))
    184 
    185 parserTakeWhile predicate = parserMany (parserSatisfy predicate)
    186 parserTakeWhile1 predicate = parserSome (parserSatisfy predicate)
    187 
    188 parserBetween open content close =
    189   parserThen open (parserBefore content close)
    190 
    191 -- A separator consumes and commits its following element on failure; callers
    192 -- who want a trailing separator must express that rule explicitly.
    193 parserSepBy1 element separator =
    194   parserBind element (first :
    195     parserMap (rest : pair first rest)
    196       (parserMany (parserThen separator element)))
    197 
    198 -- Choice for an empty sequence applies only to the *first element*. Once
    199 -- that element succeeds, a later zero-width or committed failure must not be
    200 -- hidden by falling back to the empty sequence.
    201 parserSepBy element separator input =
    202   parserMatchReply
    203     (diagnostic rest consumed committed :
    204       lazyBool
    205         (_ : parserReplyFail diagnostic rest consumed committed)
    206         (_ : parserReplyOk t input false false)
    207         (or? consumed committed))
    208     (first rest consumed committed :
    209       parserMatchReply
    210         (diagnostic2 rest2 consumed2 committed2 :
    211           parserReplyFail diagnostic2 rest2
    212             (or? consumed consumed2) (or? committed committed2))
    213         (tail rest2 consumed2 committed2 :
    214           parserReplyOk (pair first tail) rest2
    215             (or? consumed consumed2) (or? committed committed2))
    216         (parserMany (parserThen separator element) rest))
    217     (element input)
    218