success.tri (3640B)
1 !import prelude * 2 !import consumers_structural as S 3 !import consumers_lowerings_specialize as P 4 !export * 5 -- Experimental success-only constructor islands atop indexed lowering. 6 -- No matcher, binding representation, invocation protocol or host changes. 7 8 plainTail next bindings = next (snd bindings) 9 plainCapture_ self slots slot = lazyList (_ : nothing) (name rest : lazyBool (_ : just fst) (_ : lazyMaybe (_ : nothing) (next : just (plainTail next)) (self rest slot)) (equal? name slot)) slots 10 plainCapture slots slot = y plainCapture_ slots slot 11 plainFork left right bindings = pair (left bindings) (right bindings) 12 plainStem child bindings = t (child bindings) 13 -- A successful Maybe contains a plain value-producing executable. Missing 14 -- captures and every non-constructor form decline optimization, not execution. 15 plain_ self template slots = matchPair (tag payload : 16 lazyBool (_ : just (bindings : payload)) 17 (_ : lazyBool (_ : plainCapture slots payload) 18 (_ : lazyBool (_ : matchPair (left right : lazyMaybe (_ : nothing) (a : lazyMaybe (_ : nothing) (b : just (plainFork a b)) (self right slots)) (self left slots)) payload) 19 (_ : lazyBool (_ : lazyMaybe (_ : nothing) (child : just (plainStem child)) (self payload slots)) 20 (_ : nothing) (equal? tag 5)) (equal? tag 2)) (equal? tag 1)) (equal? tag 0)) template 21 plain template slots = y plain_ template slots 22 wrapPlain value bindings recur invoke = ok (value bindings) t 23 24 -- Fallback retains original evaluation/error order. Recursive compilation 25 -- discovers safe constructor islands inside calls and recursion. 26 fallback self template slots = matchPair (tag payload : 27 lazyBool (_ : matchPair (left right : P.compiledForkOutput (self left slots) (self right slots)) payload) 28 (_ : lazyBool (_ : matchPair (input state : P.compiledRecurOutput (self input slots) (self state slots)) payload) 29 (_ : lazyBool (_ : matchPair (worker more : matchPair (input continuation : matchPair (slot receiver : 30 lazyBool (_ : P.linkedCall (snd worker) (self input slots) slot (self receiver (pair slot slots))) 31 (_ : P.indexedCallOutput (self worker slots) (self input slots) slot (self receiver (pair slot slots))) (equal? (fst worker) 0)) continuation) more) payload) 32 (_ : lazyBool (_ : P.compiledStemOutput (self payload slots)) 33 (_ : lazyBool (_ : matchPair (worker more : matchPair (input state : 34 lazyBool (_ : P.linkedBecome (snd worker) (self input slots) (self state slots)) 35 (_ : P.compiledBecomeOutput (self worker slots) (self input slots) (self state slots)) (equal? (fst worker) 0)) more) payload) 36 (_ : lazyBool (_ : matchPair (left right : P.compiledEqualOutput (self left slots) (self right slots)) payload) 37 (_ : P.indexedOutput template slots) (equal? tag 8)) (equal? tag 6)) (equal? tag 5)) (equal? tag 4)) (equal? tag 3)) (equal? tag 2)) template 38 output_ self template slots = lazyMaybe (_ : fallback self template slots) (value : wrapPlain value) (plain template slots) 39 output template slots = y output_ template slots 40 rules_ self rules = lazyList (_ : input state recur invoke : err "no matching consumer rule" t) (rule rest : matchPair (inputPattern more : matchPair (statePattern template : P.directBranch (P.indexedPattern inputPattern) (P.indexedPattern statePattern) (output template (P.patternSlots statePattern (P.patternSlots inputPattern t))) (self rest)) more) rule) rules 41 compile program = S.makeConsumer (fst program) (y rules_ (snd program)) 42 compileBound program state = bindResult (P.bindState program state) (bound _ : ok (compile bound) t)