tricu

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

consumer_prefix_lexical.tri (4019B)

      1 -- Literal-prefix lowering must bind the suffix once and preserve rule fallback.
      2 !import "consumers.structural" S
      3 !import "consumers.lexical-worker" L
      4 !import "consumers.validate" V
      5 !import "consumers.registry-source" RS
      6 !import "consumers.source" C
      7 !import "parser" P
      8 !import "prelude" !Local
      9 rule input state output = S.makeRule input state output
     10 -- Independent expected expansion also covers arbitrary tree-list elements.
     11 expand_ self bytes slot = (lazyList
     12   (_ : S.patCapture slot)
     13   (head rest : S.patFork (S.patLiteral head) (self rest slot))
     14   bytes)
     15 expand bytes slot = y expand_ bytes slot
     16 expansion prefix = equal? (S.expandPrefix prefix 0) (ok (expand prefix 0) t)
     17 prefixIR prefix = S.makeConsumer t [
     18   (rule (resultOr t (S.expandPrefix prefix 0)) S.patAny (S.outCapture 0))
     19   (rule S.patAny S.patAny (S.outLiteral "miss"))]
     20 compare prefix input = (equal?
     21   (L.lRunChecked (resultOr t (L.lCompile (prefixIR prefix))) input)
     22   (S.runConsumer (prefixIR prefix) input))
     23 nested = S.makeConsumer t [
     24   (rule (S.patFork (S.patCapture 1)
     25     (resultOr t (S.expandPrefix "/api/" 0)))
     26     S.patAny (S.outFork (S.outCapture 1) (S.outCapture 0)))
     27   (rule S.patAny S.patAny (S.outLiteral "miss"))]
     28 nestedWorker = resultOr t (L.lCompile nested)
     29 longPrefix = "abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMN"
     30 longIR = prefixIR longPrefix
     31 longWorker = resultOr t (L.lCompile longIR)
     32 longProbe input expected = (and?
     33   (equal? (L.lRunChecked longWorker input) (S.runConsumer longIR input))
     34   (equal? (S.runConsumer longIR input) expected))
     35 -- The retired pattern tag remains invalid authored IR. Improper prefixes
     36 -- fail during elaboration and never produce authored IR.
     37 removedTag = S.makeConsumer t [(rule (pair 7 (pair "/api/" 0))
     38   S.patAny (S.outLiteral t))]
     39 improper = S.expandPrefix (t t) 0
     40 improperTail = S.expandPrefix (pair 65 (t t)) 0
     41 -- The lexer produces proper strings; a forged string token still fails in
     42 -- source elaboration, before a rule containing invalid IR can be published.
     43 badRoutePosition = pair 3 4
     44 badRoute = RS.rsMethod "GET" [
     45   (C.cToken C.cString (t t) badRoutePosition badRoutePosition)
     46   (C.cToken C.cName "remainder" t t)]
     47 checks = foldl and? true [
     48   (expansion "") (expansion "a") (expansion "/api/")
     49   (expansion [t 2])
     50   (compare "a" "a") (compare "a" "ab") (compare "a" "b")
     51   (compare [t 2] [t 2 3]) (compare [t 2] [t 3])
     52   (equal? (V.vValidate removedTag)
     53     (err (V.vDiagnostic "malformed" 0 ["input pattern"]
     54       "unknown pattern tag") t))
     55   (equal? (L.lCompile removedTag) (V.vValidate removedTag))
     56   (equal? improper (err "improper literal prefix" t))
     57   (equal? improperTail (err "improper literal prefix" t))
     58   (equal? (fst badRoute) false)
     59   (equal? (P.parserDiagnosticCode (P.parserReplyPayload badRoute)) 23)
     60   (equal? (P.parserDiagnosticLocation (P.parserReplyPayload badRoute))
     61     badRoutePosition)
     62   (equal? (S.expandPrefix "" 0) (ok (S.patCapture 0) t))
     63   (equal? (S.expandPrefix "a" 0)
     64     (ok (S.patFork (S.patLiteral 97) (S.patCapture 0)) t))
     65   (compare "" "")
     66   (compare "" "data")
     67   (compare "/api/" "/api/")
     68   (compare "/api/" "/api/item")
     69   (compare "/api/" "/api")
     70   (compare "/api/" "/apix/item")
     71   (compare "/api/" "/other")
     72   (compare "/api/" t)
     73   (compare "/api/" (t t))
     74   (compare "" (pair 65 t))
     75   (resultIsOk (V.vValidate longIR))
     76   (longProbe longPrefix (ok t t))
     77   (longProbe (append longPrefix "/item") (ok "/item" t))
     78   (longProbe "abcdefghijXlmnopqrstuvwxyz0123456789ABCDEFGHIJKLMN"
     79     (ok "miss" t))
     80   (longProbe "abcdefghij" (ok "miss" t))
     81   (longProbe (pair 97 (t t)) (ok "miss" t))
     82   (equal? (L.lRunChecked (resultOr t (L.lCompile (prefixIR "/api/"))) "/api/item")
     83     (ok "item" t))
     84   (equal? (L.lRunChecked nestedWorker (pair 42 "/api/item"))
     85     (S.runConsumer nested (pair 42 "/api/item")))
     86   (equal? (L.lRunChecked nestedWorker (pair 42 "/api/item"))
     87     (ok (pair 42 "item") t))
     88   (equal? (L.lRunChecked nestedWorker (pair 42 "/wrong")) (ok "miss" t))]
     89 main = matchBool "consumer-prefix-ok" "consumer-prefix-DIFFER" checks
     90 main