diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/source/luxc/lang/synthesis/case.lux | 17 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/synthesis/expression.lux | 58 |
2 files changed, 38 insertions, 37 deletions
diff --git a/new-luxc/source/luxc/lang/synthesis/case.lux b/new-luxc/source/luxc/lang/synthesis/case.lux index 15cb6eca3..e66bbf3a8 100644 --- a/new-luxc/source/luxc/lang/synthesis/case.lux +++ b/new-luxc/source/luxc/lang/synthesis/case.lux @@ -2,6 +2,7 @@ lux (lux (data [bool "bool/" Eq<Bool>] [text "text/" Eq<Text>] + text/format [number] (coll [list "list/" Fold<List>])) (meta [code "code/" Eq<Code>])) @@ -11,7 +12,7 @@ (def: #export (path pattern) (-> la;Pattern ls;Path) (case pattern - (^code [(~@ membersP)]) + (^code ("lux case tuple" [(~@ membersP)])) (case (list;reverse membersP) #;Nil (' ("lux case pop")) @@ -30,12 +31,16 @@ [(n.dec last-idx) (` ("lux case tuple right" (~ (code;nat last-idx)) (~ (path lastP))))] prevsP)] - tuple-path)) + (` ("lux case seq" + (~ tuple-path) + ("lux case pop"))))) - (^code ((~ [_ (#;Nat tag)]) (~ [_ (#;Nat num-tags)]) (~ memberP))) - (if (n.= (n.dec num-tags) tag) - (` ("lux case variant right" (~ (code;nat tag)) (~ (path memberP)))) - (` ("lux case variant left" (~ (code;nat tag)) (~ (path memberP))))) + (^code ("lux case variant" (~ [_ (#;Nat tag)]) (~ [_ (#;Nat num-tags)]) (~ memberP))) + (` ("lux case seq" + (~ (if (n.= (n.dec num-tags) tag) + (` ("lux case variant right" (~ (code;nat tag)) (~ (path memberP)))) + (` ("lux case variant left" (~ (code;nat tag)) (~ (path memberP)))))) + ("lux case pop"))) _ pattern)) diff --git a/new-luxc/source/luxc/lang/synthesis/expression.lux b/new-luxc/source/luxc/lang/synthesis/expression.lux index 05b99923b..531606ba7 100644 --- a/new-luxc/source/luxc/lang/synthesis/expression.lux +++ b/new-luxc/source/luxc/lang/synthesis/expression.lux @@ -85,11 +85,11 @@ (|> (synthesize expr) (~) ("lux case exec") ("lux case seq" (~ (caseS;path pattern))) - (`))))] - (` ("lux case" (~ inputS) - (~ (list/fold caseS;weave - (transform-branch lastP lastA) - (list/map (product;uncurry transform-branch) prevsPA)))))) + (`)))) + pathS (list/fold caseS;weave + (transform-branch lastP lastA) + (list/map (product;uncurry transform-branch) prevsPA))] + (` ("lux case" (~ inputS) (~ pathS)))) _ (undefined) @@ -117,46 +117,42 @@ _ (call$ funcS argsS)))) -(def: #export (synthesize analysis) +(def: #export (synthesize expressionA) (-> la;Analysis ls;Synthesis) (loop [outer-arity +0 resolver init-resolver num-locals +0 - exprA analysis] - (case exprA + expressionA expressionA] + (case expressionA (^code [(~ _left) (~ _right)]) - (` [(~@ (list/map (recur +0 resolver num-locals) (la;unfold-tuple exprA)))]) + (` [(~@ (list/map (recur outer-arity resolver num-locals) (la;unfold-tuple expressionA)))]) (^or (^code ("lux sum left" (~ _))) (^code ("lux sum right" (~ _)))) - (let [[tag last? value] (maybe;assume (la;unfold-variant exprA))] - (variant$ tag last? (recur +0 resolver num-locals value))) + (let [[tag last? value] (maybe;assume (la;unfold-variant expressionA))] + (variant$ tag last? (recur outer-arity resolver num-locals value))) (^code ((~ [_ (#;Int var)]))) (if (variableL;local? var) - (let [register (variableL;local-register var)] - (if (functionS;nested? outer-arity) - (if (n.= +0 register) - (call$ (var$ 0) (|> (list;n.range +1 (n.dec outer-arity)) - (list/map (|>. variableL;local code;int (~) () (`))))) - (var$ (functionS;adjust-var outer-arity (variableL;local register)))) - (var$ (variableL;local register)))) - (let [register (variableL;captured-register var)] - (var$ (let [var (variableL;captured register)] - (maybe;default var (dict;get var resolver)))))) + (if (functionS;nested? outer-arity) + (if (variableL;self? var) + (call$ (var$ 0) (|> (list;n.range +1 (n.dec outer-arity)) + (list/map (|>. variableL;local code;int (~) () (`))))) + (var$ (functionS;adjust-var outer-arity var))) + (var$ var)) + (var$ (maybe;default var (dict;get var resolver)))) (^code ("lux case" (~ inputA) (~ [_ (#;Record branchesA)]))) - (synthesize-case (recur +0 resolver num-locals) inputA branchesA) + (synthesize-case (recur outer-arity resolver num-locals) inputA branchesA) (^multi (^code ("lux function" [(~@ scope)] (~ bodyA))) [(s;run scope (p;some s;int)) (#e;Success raw-env)]) (let [inner-arity (n.inc outer-arity) env (list/map (function [var] (maybe;default var (dict;get var resolver))) raw-env) - env-vars (let [env-size (list;size raw-env)] - (: (List Variable) - (case env-size - +0 (list) - _ (list/map variableL;captured (list;n.range +0 (n.dec env-size)))))) + env-vars (: (List Variable) + (case raw-env + #;Nil (list) + _ (|> (list;size raw-env) n.dec (list;n.range +0) (list/map variableL;captured)))) resolver' (if (functionS;nested? inner-arity) (list/fold (function [[from to] resolver'] (dict;put from to resolver')) @@ -166,7 +162,7 @@ (dict;put var var resolver')) init-resolver env-vars))] - (case (recur inner-arity resolver' +0 bodyA) + (case (recur inner-arity resolver' num-locals bodyA) (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat arity')] env' bodyS'))]) (let [arity (n.inc arity')] (function$ arity env (prepare-body inner-arity arity bodyS'))) @@ -175,10 +171,10 @@ (function$ +1 env (prepare-body inner-arity +1 bodyS)))) (^code ("lux apply" (~@ _))) - (synthesize-apply synthesize outer-arity num-locals exprA) + (synthesize-apply (recur outer-arity resolver num-locals) outer-arity num-locals expressionA) (^code ((~ [_ (#;Text name)]) (~@ args))) - (procedure$ name (list/map (recur +0 resolver num-locals) args)) + (procedure$ name (list/map (recur outer-arity resolver num-locals) args)) _ - exprA))) + expressionA))) |