tricu

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

structural.tri (2578B)

      1 !import consumers_structural *
      2 !import consumers_fizzbuzz *
      3 !import prelude *
      4 !export *
      5 -- Structural SCP demonstration and assertions.
      6 
      7 -- This interpreter is the same one as for FizzBuzz. The worker lives in
      8 -- state as ordinary data; Call's receiver retains the pending tail explicitly.
      9 mapNextRest nextState = outRecur (outCapture 1) nextState
     10 mapConsumer worker = makeConsumer worker [(makeRule patLeaf patAny (outLiteral t))
     11    (makeRule listInput (patCapture 2)
     12       (outCall (outCapture 2) (outCapture 0) 3
     13         (outFork (outCapture 3) (mapNextRest (outCapture 2)))))]
     14 identityWorker = makeConsumer t [(makeRule (patCapture 0) patAny (outCapture 0))]
     15 literalWorker = makeConsumer t [(makeRule patAny patAny (outLiteral "Fizz"))]
     16 excitedWorker = replaceLiteral literalWorker "Fizz" "Fizz!"
     17 mapIdentityMatches = equal? (resultOr (t t) (runConsumer (mapConsumer identityWorker) [7 8 9])) [7 8 9]
     18 mapTransformedMatches = equal? (resultOr (t t) (runConsumer (mapConsumer excitedWorker) [7 8 9])) ["Fizz!" "Fizz!" "Fizz!"]
     19 mapOriginalMatches = equal? (resultOr (t t) (runConsumer (mapConsumer literalWorker) [7 8 9])) ["Fizz" "Fizz" "Fizz"]
     20 structureRestored = equal? (replaceLiteral excited "Fizz!" "Fizz") fizzbuzz
     21 missingRuleFails = matchResult (message _ : equal? message "no matching consumer rule") (_ _ : false)
     22   (runConsumer (makeConsumer t [(makeRule patLeaf patAny (outLiteral t))]) [1])
     23 unknownCaptureFails = matchResult (message _ : equal? message "unknown capture") (_ _ : false)
     24   (runConsumer (makeConsumer t [(makeRule patAny patAny (outCapture 99))]) t)
     25 literalMatches = and? (maybe? (matchPattern (patLiteral 9) 9 t))
     26   (not? (maybe? (matchPattern (patLiteral 9) 10 t)))
     27 asCaptureWorks = equal? (resultOr t (runConsumer
     28   (makeConsumer t [(makeRule (patAs 1 (patLiteral 9)) patAny
     29     (outCapture 1))]) 9)) 9
     30 stemCaptureWorks = equal? (resultOr t (runConsumer
     31   (makeConsumer t [(makeRule (patCapture 0) patAny
     32     (outStem (outCapture 0)))]) 9)) (t 9)
     33 
     34 
     35 fizzbuzzMatches = equal? (resultOr t (runConsumer fizzbuzz input)) expected
     36 excitedMatches = equal? (resultOr t (runConsumer excited input)) excitedExpected
     37 emptyMatches = equal? (resultOr (t t) (runConsumer fizzbuzz t)) t
     38 allChecks = and? fizzbuzzMatches (and? excitedMatches (and? emptyMatches (and? mapIdentityMatches (and? mapTransformedMatches (and? mapOriginalMatches (and? structureRestored (and? missingRuleFails (and? unknownCaptureFails (and? literalMatches (and? asCaptureWorks stemCaptureWorks))))))))))
     39 main = lazyBool (_ : "consumer-spike-ok") (_ : "consumer-spike-failed") allChecks