tricu

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

layout.tri (3238B)

      1 !import prelude *
      2 !import parser as P
      3 !import source_parser as S
      4 !import source_lexer as L
      5 !import consumers_structural as SCP
      6 !import consumers_layout *
      7 !export *
      8 -- Real located-token layout transition as authored consumer data.
      9 -- Differential oracle: sourceGateParseLayoutValue with a small name parser.
     10 
     11 -- Reuse the library constructors; the oracle and concrete probes below are
     12 -- instructional fixtures, not part of the library import surface.
     13 
     14 -- Oracle uses the existing layout transition and its finite-stream reply.
     15 inlineName = P.parserMap (token : pair 0 token) (S.sourceGateExpect L.sourceTokenName)
     16 indentedName column = P.parserMap (token : pair column token) (S.sourceGateExpect L.sourceTokenName)
     17 reference = S.sourceGateParseLayoutValue inlineName indentedName "definition body"
     18 referenceCommitted = P.parserThen P.parserCommit reference
     19 
     20 -- These are real located source tokens, not mock list or ASCII tags. Only the
     21 -- fixed "x =" prefix is removed; the remaining source is the layout value.
     22 bodyTokens source =
     23   matchList t (_ rest :
     24     matchList t (_ remaining : remaining) rest) (P.parserReplyPayload (L.lexGateSource source))
     25 
     26 sameReply source committed =
     27   (input : equal?
     28     (resultOr t (SCP.runConsumer
     29       (lazyBool (_ : layoutWithCommit) (_ : layout) committed) input))
     30     ((lazyBool (_ : referenceCommitted) (_ : reference) committed) input))
     31     (bodyTokens source)
     32 
     33 allReplies = foldl and? true [(sameReply "x = y" false)
     34   (sameReply "x =\n  y" false) (sameReply "x =\ny" false)
     35   (sameReply "x =\n\n  y" false) (sameReply "x =\n  7" false)
     36   (sameReply "x = 7" false) (sameReply "x =\n" false)
     37   (sameReply "x =" false) (sameReply "x = y" true)
     38   (sameReply "x =\n  y" true) (sameReply "x = 7" true)
     39   (sameReply "x =\n  7" true) (sameReply "x =\n  y z" false)]
     40 
     41 consumerParser committed input =
     42   resultOr t (SCP.runConsumer
     43     (lazyBool (_ : layoutWithCommit) (_ : layout) committed) input)
     44 selectedColumn source =
     45   fst (P.parserReplyPayload (consumerParser false (bodyTokens source)))
     46 retry source committed attempted =
     47   (input : P.parserOr
     48     (lazyBool (_ : P.parserAttempt (consumerParser committed))
     49       (_ : consumerParser committed) attempted)
     50     (P.parserPure 99) input) (bodyTokens source)
     51 
     52 transformedChecks = foldl and? true [(equal? (SCP.replaceLiteral renamedLayout "missing indented value" "definition body") layout)
     53    (equal? (P.parserDiagnosticExpected (P.parserReplyPayload
     54       (resultOr t (SCP.runConsumer renamedLayout (bodyTokens "x =\n")))))
     55       "missing indented value")
     56    (equal? (resultOr t (SCP.runConsumer renamedLayout (bodyTokens "x =\n  y")))
     57       (reference (bodyTokens "x =\n  y")))]
     58 
     59 protocolChecks = foldl and? true [(equal? (selectedColumn "x = y") 0)
     60   (equal? (selectedColumn "x =\ny") 0)
     61   (equal? (selectedColumn "x =\n  y") 3)
     62   (equal? (P.parserReplyPayload (retry "x = 7" false false)) 99)
     63   (not? (fst (retry "x =\n  7" false false)))
     64   (not? (fst (retry "x = 7" true false)))
     65   (equal? (P.parserReplyPayload (retry "x = 7" true true)) 99)
     66   (equal? (P.parserReplyPayload (retry "x =\n  7" true true)) 99)]
     67 main = lazyBool (_ : "layout-consumer-ok") (_ : "layout-consumer-failed") (and? allReplies (and? protocolChecks transformedChecks))