tricu

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

consumer_project_patterns.tri (2365B)

      1 !import "consumers.lowerings.project" Q
      2 !import "consumers.structural" S
      3 !import "consumers.lowerings.specialize" P
      4 !import "prelude" !Local
      5 rule input state output = S.makeRule input state output
      6 same program input = equal? (S.runConsumer program input) (P.runDirect (Q.compile program) input)
      7 probe pattern value = same (S.makeConsumer t [(rule pattern S.patAny (S.outCapture 0))]) value
      8 identity = Q.compile (S.makeConsumer t [(rule (S.patCapture 0) S.patAny (S.outCapture 0))])
      9 call = S.makeConsumer t [(rule (S.patCapture 0) (S.patCapture 1) (S.outCall (S.outLiteral identity) (S.outLiteral 7) 0 (S.outFork (S.outCapture 0) (S.outCapture 1))))]
     10 nestedCall = S.makeConsumer t [(rule (S.patCapture 0) (S.patCapture 1) (S.outCall (S.outLiteral identity) (S.outLiteral 7) 2 (S.outCall (S.outLiteral identity) (S.outLiteral 8) 3 (S.outFork (S.outCapture 0) (S.outFork (S.outCapture 2) (S.outCapture 3))))))]
     11 checks = foldl and? true [(probe (S.patCapture 0) 9)
     12  (probe S.patLeaf t)
     13  (probe S.patLeaf (t t))
     14  (probe (S.patStem (S.patCapture 0)) (pair 9 8))
     15  (probe (S.patFork (S.patCapture 0) S.patAny) (t 9))
     16  (probe (pair 99 t) 9)
     17  (same (S.makeConsumer t t) 9)
     18  (same (S.makeConsumer t [(rule S.patAny S.patAny (S.outLiteral 1)) (rule S.patAny S.patAny (S.outLiteral 2))]) 9)
     19  (same (S.makeConsumer 42 [(rule (S.patCapture 0) (S.patCapture 0) (S.outCapture 0))]) 9)
     20  (same (S.makeConsumer t [(rule S.patAny S.patAny (pair 99 t))]) 9)
     21  (equal? (P.runDirect (Q.compile nestedCall) 91) (ok (pair 91 (pair 7 8)) t))
     22  (probe (S.patStem (S.patCapture 0)) (t 9))
     23  (probe (S.patFork (S.patCapture 0) S.patAny) (pair 9 8))
     24  (probe (S.patFork S.patAny (S.patCapture 0)) (pair 9 8))
     25  (probe (S.patAs 0 S.patLeaf) t)
     26  (probe (S.patAs 0 (S.patCapture 0)) 9)
     27  (probe (resultOr t (S.expandPrefix "/api/" 0)) "/api/item")
     28  (probe (resultOr t (S.expandPrefix "/api/" 0)) "/other")
     29  (probe (resultOr t (S.expandPrefix "/api/" 0)) "/api/")
     30  (probe (S.patAs 0 S.patLeaf) (t t))
     31  (probe (S.patLiteral 9) 9)
     32  (same (S.makeConsumer t [(rule (S.patCapture 0) (S.patLiteral 9) (S.outCapture 0)) (rule S.patAny S.patAny (S.outCapture 0))]) 8)
     33  (equal? (P.runDirect (Q.compile call) 91) (ok (pair 7 t) t))
     34  (equal? (bindResult (Q.compileBound call 42) (compiled _ : P.runDirect compiled 91)) (ok (pair 7 42) t))]
     35 main = matchBool "project-patterns-ok" "project-patterns-DIFFER" checks
     36 main