diff options
author | Eduardo Julian | 2018-08-15 19:06:17 -0400 |
---|---|---|
committer | Eduardo Julian | 2018-08-15 19:06:17 -0400 |
commit | 196c1843d1a4a32ab92b9ba5c549933a5ce30c17 (patch) | |
tree | bd5e6d432601bec6409cb5edbc4e19865bf4fc24 /stdlib/source/lux/compiler/default/phase/synthesis/case.lux | |
parent | 453ab9f67873bb022acadf4c0f5c1e635c7d5794 (diff) |
Fixes for pattern-matching/case synthesis & translation.
Diffstat (limited to 'stdlib/source/lux/compiler/default/phase/synthesis/case.lux')
-rw-r--r-- | stdlib/source/lux/compiler/default/phase/synthesis/case.lux | 67 |
1 files changed, 32 insertions, 35 deletions
diff --git a/stdlib/source/lux/compiler/default/phase/synthesis/case.lux b/stdlib/source/lux/compiler/default/phase/synthesis/case.lux index 3e59637a8..c9de46ac9 100644 --- a/stdlib/source/lux/compiler/default/phase/synthesis/case.lux +++ b/stdlib/source/lux/compiler/default/phase/synthesis/case.lux @@ -19,18 +19,22 @@ [// ["." reference]]]]) -(def: (path' pattern bodyC) - (-> Pattern (Operation Path) (Operation Path)) +(def: clean-up + (-> Path Path) + (|>> (#//.Seq #//.Pop))) + +(def: (path' pattern end? thenC) + (-> Pattern Bit (Operation Path) (Operation Path)) (case pattern (#analysis.Simple simple) (case simple #analysis.Unit - bodyC + thenC (^template [<from> <to>] (<from> value) (operation/map (|>> (#//.Seq (#//.Test (|> value <to>)))) - bodyC)) + thenC)) ([#analysis.Bit #//.Bit] [#analysis.Nat (<| #//.I64 .i64)] [#analysis.Int (<| #//.I64 .i64)] @@ -45,40 +49,33 @@ (n/+ (dec arity) register) register))))) //.with-new-local - bodyC) - - (#analysis.Complex _) - (case (analysis.variant-pattern pattern) - (#.Some [lefts right? value-pattern]) - (operation/map (|>> (#//.Seq (#//.Access (#//.Side (if right? - (#.Right lefts) - (#.Left lefts)))))) - (path' value-pattern bodyC)) - - #.None - (let [tuple (analysis.tuple-pattern pattern) - tuple/last (dec (list.size tuple))] - (list/fold (function (_ [tuple/idx tuple/member] thenC) - (case tuple/member - (#analysis.Simple #analysis.Unit) - thenC - - _ - (let [last? (n/= tuple/last tuple/idx)] - (|> (if (or last? - (is? bodyC thenC)) - thenC - (operation/map (|>> (#//.Seq #//.Pop)) thenC)) - (path' tuple/member) - (operation/map (|>> (#//.Seq (#//.Access (#//.Member (if last? - (#.Right (dec tuple/idx)) - (#.Left tuple/idx))))))))))) - bodyC - (list.reverse (list.enumerate tuple))))))) + thenC) + + (#analysis.Complex (#analysis.Variant [lefts right? value-pattern])) + (<| (operation/map (|>> (#//.Seq (#//.Access (#//.Side (if right? + (#.Right lefts) + (#.Left lefts))))))) + (path' value-pattern end?) + (when (not end?) (operation/map ..clean-up)) + thenC) + + (#analysis.Complex (#analysis.Tuple tuple)) + (let [tuple::last (dec (list.size tuple))] + (list/fold (function (_ [tuple::lefts tuple::member] nextC) + (let [right? (n/= tuple::last tuple::lefts) + end?' (and end? right?)] + (<| (operation/map (|>> (#//.Seq (#//.Access (#//.Member (if right? + (#.Right (dec tuple::lefts)) + (#.Left tuple::lefts))))))) + (path' tuple::member end?') + (when (not end?') (operation/map ..clean-up)) + nextC))) + thenC + (list.reverse (list.enumerate tuple)))))) (def: #export (path synthesize pattern bodyA) (-> Phase Pattern Analysis (Operation Path)) - (path' pattern (operation/map (|>> #//.Then) (synthesize bodyA)))) + (path' pattern true (operation/map (|>> #//.Then) (synthesize bodyA)))) (def: #export (weave leftP rightP) (-> Path Path Path) |