tricu

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

consumer_base_as_source.tri (2280B)

      1 -- General source patterns lower to the same validated lexical IR.
      2 !import "consumers.base-source" B
      3 !import "consumers.structural" S
      4 !import "consumers.lexical-worker" L
      5 !import "consumers.validate" V
      6 !import "parser" P
      7 !import "lexer" Position
      8 !import "prelude" !Local
      9 
     10 source = "consumer generalPatterns\n  (\"GET\", as route [head | tail]) @ _ => route\n  (as whole (left, right), final) @ state => (whole, final)"
     11 parsed = B.compileBaseSource source
     12 located = B.compileBaseSourceLocated source
     13 locations = snd (resultOr t located)
     14 firstRuleLocation = fst (fst locations)
     15 firstOutputLocation = snd (fst locations)
     16 secondRuleLocation = fst (fst (snd locations))
     17 secondOutputLocation = snd (fst (snd locations))
     18 program = snd (resultOr t parsed)
     19 compiled = L.lCompile program
     20 worker = resultOr t compiled
     21 runBoth input = equal? (L.lRunChecked worker input) (S.runConsumer program input)
     22 duplicate = (B.compileBaseSource
     23   "consumer duplicate\n  as x (x, y) @ _ => x")
     24 checks = foldl and? true [
     25   (resultIsOk parsed)
     26   (resultIsOk located)
     27   (equal? (fst (resultOr t located)) (resultOr t parsed))
     28   (equal? (Position.lexerPositionLine firstRuleLocation) 2)
     29   (equal? (Position.lexerPositionColumn firstRuleLocation) 3)
     30   (equal? (Position.lexerPositionColumn firstOutputLocation) 42)
     31   (equal? (Position.lexerPositionLine secondRuleLocation) 3)
     32   (equal? (Position.lexerPositionColumn secondOutputLocation) 46)
     33   (equal? (B.bsDiagnosticLocation
     34     (V.vDiagnostic "malformed" 1 ["output"] "unknown capture") locations)
     35     secondOutputLocation)
     36   (equal? (B.bsDiagnosticLocation
     37     (V.vDiagnostic "malformed" 0 ["left" "input pattern"] "bad") locations)
     38     firstRuleLocation)
     39   (equal? (B.bsDiagnosticLocation
     40     (V.vDiagnostic "malformed" 99 ["output"] "bad") locations) t)
     41   (resultIsOk compiled)
     42   (runBoth (pair "GET" [7 8]))
     43   (equal? (L.lRunChecked worker (pair "GET" [7 8])) (ok [7 8] t))
     44   (runBoth (pair (pair 1 2) 3))
     45   (equal? (L.lRunChecked worker (pair (pair 1 2) 3))
     46     (ok (pair (pair 1 2) 3) t))
     47   (equal? (L.lRunChecked worker t) (err "no matching consumer rule" t))
     48   (matchResult
     49     (diagnostic _ : equal? (P.parserDiagnosticCode diagnostic) 21)
     50     (_ _ : false) duplicate)]
     51 main = matchBool "consumer-base-as-ok" "consumer-base-as-DIFFER" checks
     52 main