consumer_validation.tri (3522B)
1 -- Focused authored-IR validation probe; reference shadowing remains independent. 2 !import "consumers.validate" V 3 !import "consumers.lexical-worker" L 4 !import "consumers.structural" S 5 !import "prelude" !Local 6 7 rule input state output = S.makeRule input state output 8 consumer rules = S.makeConsumer t rules 9 errorCategory result = matchResult (diagnostic _ : fst diagnostic) (_ _ : "ok") result 10 errorDetail result = (matchResult 11 (diagnostic _ : snd (snd (snd diagnostic))) 12 (_ _ : "ok") result) 13 errorRule result = (matchResult 14 (diagnostic _ : fst (snd diagnostic)) 15 (_ _ : 99) result) 16 errorPath result = (matchResult 17 (diagnostic _ : fst (snd (snd diagnostic))) 18 (_ _ : t) result) 19 20 validInput = S.patAs 0 (S.patFork (S.patCapture 1) (S.patCapture 2)) 21 validOutput = S.outFork (S.outCapture 0) (S.outCapture 3) 22 valid = consumer [(rule validInput (S.patCapture 3) validOutput)] 23 shadow = consumer [(rule (S.patCapture 0) (S.patCapture 0) (S.outCapture 0))] 24 receiverOutput = S.outCall (S.outLiteral t) (S.outLiteral t) 0 (S.outCapture 0) 25 receiverShadow = consumer [(rule S.patAny S.patAny receiverOutput)] 26 receiverLeak = consumer [(rule S.patAny S.patAny 27 (S.outFork receiverOutput (S.outCapture 0)))] 28 opaque = consumer [(rule (S.patLiteral (S.outCapture 999)) S.patAny 29 (S.outLiteral (S.patFork (S.patCapture 0) S.patAny)))] 30 unknownCapture = consumer [(rule S.patAny S.patAny (S.outCapture 99))] 31 prefix = consumer [(rule (resultOr t (S.expandPrefix "a" 0)) S.patAny (S.outLiteral t))] 32 become = consumer [(rule S.patAny S.patAny 33 (S.outBecome (S.outLiteral t) (S.outLiteral t) (S.outLiteral t)))] 34 twoRules = consumer [(rule S.patAny S.patAny (S.outLiteral t)) 35 (rule S.patAny S.patAny (S.outCapture 5))] 36 twoRulesUnsupported = consumer [(rule S.patAny S.patAny (S.outLiteral t)) 37 (rule (resultOr t (S.expandPrefix "a" 0)) S.patAny (S.outLiteral t))] 38 badRules = consumer (t t) 39 badPattern = consumer [(rule (pair 3 t) S.patAny (S.outLiteral t))] 40 badOutput = consumer [(rule S.patAny S.patAny (pair 8 t))] 41 badTag = consumer [(rule (pair 42 t) S.patAny (S.outLiteral t))] 42 receiverDuplicate = consumer [(rule (S.patCapture 0) S.patAny 43 (S.outCall (S.outLiteral t) (S.outLiteral t) 0 (S.outCapture 0)))] 44 45 checks = foldl and? true [ 46 (resultIsOk (V.vValidate valid)) 47 (resultIsOk (L.lCompile valid)) 48 (equal? (errorDetail (V.vValidate shadow)) "duplicate binding") 49 (equal? (errorCategory (L.lCompile shadow)) "malformed") 50 (resultIsOk (V.vValidate receiverShadow)) 51 (equal? (errorDetail (V.vValidate receiverLeak)) "unknown capture") 52 (resultIsOk (V.vValidate opaque)) 53 (resultIsOk (L.lCompile opaque)) 54 (equal? (errorDetail (V.vValidate unknownCapture)) "unknown capture") 55 (resultIsOk (L.lCompile prefix)) 56 (resultIsOk (L.lCompile become)) 57 (resultIsOk (L.lCompile twoRulesUnsupported)) 58 (equal? (errorPath (V.vValidate badTag)) ["input pattern"]) 59 (resultIsOk (V.vValidate prefix)) 60 (resultIsOk (V.vValidate become)) 61 (equal? (errorDetail (V.vValidate badRules)) "rule list") 62 (equal? (errorDetail (V.vValidate badPattern)) "fork payload") 63 (equal? (errorDetail (V.vValidate badOutput)) "pair payload") 64 (equal? (errorDetail (V.vValidate badTag)) "unknown pattern tag") 65 (equal? (errorDetail (V.vValidate receiverDuplicate)) "duplicate binding") 66 (equal? (errorPath (V.vValidate receiverDuplicate)) ["receiver" "output"]) 67 (equal? (S.runConsumer shadow 4) (ok t t)) 68 (equal? (errorRule (V.vValidate twoRules)) 1)] 69 main = matchBool "consumer-validation-ok" "consumer-validation-DIFFER" checks 70 main