From 4480e41e949ba3ba0c9bceeed43e3f144f82103b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 6 Jun 2017 20:23:15 -0400 Subject: - Now optimizing functions. --- new-luxc/source/luxc/lang/synthesis.lux | 8 +- new-luxc/source/luxc/synthesizer.lux | 180 +++++++++++-------------- new-luxc/source/luxc/synthesizer/function.lux | 55 ++++++++ new-luxc/source/luxc/synthesizer/structure.lux | 28 ++++ 4 files changed, 168 insertions(+), 103 deletions(-) create mode 100644 new-luxc/source/luxc/synthesizer/function.lux create mode 100644 new-luxc/source/luxc/synthesizer/structure.lux (limited to 'new-luxc/source/luxc') diff --git a/new-luxc/source/luxc/lang/synthesis.lux b/new-luxc/source/luxc/lang/synthesis.lux index 5fd6a3a81..f5d3f9c33 100644 --- a/new-luxc/source/luxc/lang/synthesis.lux +++ b/new-luxc/source/luxc/lang/synthesis.lux @@ -1,6 +1,8 @@ (;module: lux) +(def: #export Variable Int) + (type: #export (Path' s) #PopP (#BindP Nat) @@ -29,12 +31,12 @@ (#Variant Nat Bool Synthesis) (#Tuple (List Synthesis)) (#Case Synthesis (Path' Synthesis)) - (#Function Nat Scope Synthesis) + (#Function Nat (List Variable) Synthesis) (#Call Synthesis (List Synthesis)) (#Recur Nat (List Synthesis)) (#Procedure Text (List Synthesis)) - (#Relative Int) - (#Absolute Ident) + (#Variable Variable) + (#Definition Ident) (#Let Nat Synthesis Synthesis) (#If Synthesis Synthesis Synthesis) (#Loop Nat (List Synthesis) Synthesis)) diff --git a/new-luxc/source/luxc/synthesizer.lux b/new-luxc/source/luxc/synthesizer.lux index 04a699993..5dc4fa258 100644 --- a/new-luxc/source/luxc/synthesizer.lux +++ b/new-luxc/source/luxc/synthesizer.lux @@ -1,58 +1,16 @@ (;module: lux - (lux (data (coll [list "L/" Functor]))) + (lux (data text/format + [number] + (coll [list "L/" Functor Fold] + ["d" dict]))) (luxc ["&" base] (lang ["la" analysis] ["ls" synthesis]) - ## (synthesizer ["&&;" case]) + (synthesizer ["&&;" structure] + ["&&;" function]) )) -## (do-template [ ] -## [(def: ( ref) -## (-> Int Bool) -## ( 0 ref))] - -## [function-ref? i.=] -## [local-ref? i.>] -## [captured-ref? i.<] -## ) - -(def: (unfold-tuple tuple) - (-> la;Analysis (List la;Analysis)) - (case tuple - (#la;Product left right) - (#;Cons left (unfold-tuple right)) - - _ - (list tuple))) - -(def: (unfold-apply apply) - (-> la;Analysis [la;Analysis (List la;Analysis)]) - (loop [apply apply - args (list)] - (case apply - (#la;Apply arg func) - (recur func (#;Cons arg args)) - - _ - [apply args]))) - -(def: (unfold-variant variant) - (-> (Either la;Analysis la;Analysis) [Nat Bool la;Analysis]) - (loop [so-far +0 - variantA variant] - (case variantA - (#;Left valueA) - (case valueA - (#la;Sum choice) - (recur (n.inc so-far) choice) - - _ - [so-far false valueA]) - - (#;Right valueA) - [(n.inc so-far) true valueA]))) - ## (def: (has-self-reference? exprS) ## (-> ls;Synthesis Bool) ## (case exprS @@ -65,7 +23,7 @@ ## (#ls;Variant tag last? memberS) ## (has-self-reference? memberS) -## (#ls;Relative idx) +## (#ls;Variable idx) ## (i.= 0 idx) ## (#ls;Recur offset argsS) @@ -108,11 +66,11 @@ ## (#ls;Variant tag last? valueS) ## (#ls;Variant tag last? (recur valueS)) -## (#ls;Relative idx) +## (#ls;Variable idx) ## (if (captured-ref? idx) ## (let [scope-idx (|> idx (n.+ 1) (n.* -1) int-to-nat)] -## (|> scope (list;nth scope-idx) assume #ls;Relative)) -## (#ls;Relative (i.+ idx (nat-to-int offset)))) +## (|> scope (list;nth scope-idx) assume #ls;Variable)) +## (#ls;Variable (i.+ idx (nat-to-int offset)))) ## (#ls;Recur _offset argsS) ## (#ls;Recur (n.+ offset _offset) (L/map recur argsS)) @@ -136,11 +94,13 @@ ## exprS ## ))) +(def: init-env (List ls;Variable) (list)) +(def: init-resolver (d;Dict Int Int) (d;new number;Hash)) + (def: #export (synthesize analysis) (-> la;Analysis ls;Synthesis) - (loop [num-args +0 - local-offset +0 - tail? true + (loop [scope-args +0 + resolver init-resolver exprA analysis] (case exprA (^template [ ] @@ -154,27 +114,72 @@ [#la;Real #ls;Real] [#la;Char #ls;Char] [#la;Text #ls;Text] - [#la;Absolute #ls;Absolute]) + [#la;Absolute #ls;Definition]) (#la;Product _) - (#ls;Tuple (L/map (recur +0 local-offset false) (unfold-tuple exprA))) + (#ls;Tuple (L/map (recur +0 resolver) (&&structure;unfold-tuple exprA))) (#la;Sum choice) - (let [[tag last? value] (unfold-variant choice)] - (#ls;Variant tag last? (recur +0 local-offset false value))) - + (let [[tag last? value] (&&structure;unfold-variant choice)] + (#ls;Variant tag last? (recur +0 resolver value))) + + (#la;Relative ref) + (if (&&function;nested-function? scope-args) + (case ref + (#;Local local) + (if (n.= +0 local) + (<| (#ls;Call (#ls;Variable 0)) + (L/map (|>. nat-to-int #ls;Variable)) + (list;n.range +1 (n.dec scope-args))) + (#ls;Variable (&&function;adjust-var scope-args (nat-to-int local)))) + + (#;Captured register) + (#ls;Variable (default (&&function;to-captured register) + (d;get (&&function;to-captured register) resolver)))) + (case ref + (#;Local local) + (#ls;Variable (nat-to-int local)) + + (#;Captured register) + (#ls;Variable (&&function;to-captured register)))) + + (#la;Function scope bodyA) + (let [num-args (n.inc scope-args) + raw-env (&&function;environment scope) + env (L/map (function [var] (default var (d;get var resolver))) raw-env) + env-vars (let [env-size (list;size raw-env)] + (: (List ls;Variable) + (case env-size + +0 (list) + _ (L/map &&function;to-captured (list;n.range +0 (n.dec env-size)))))) + resolver' (if (&&function;nested-function? num-args) + (L/fold (function [[from to] resolver'] + (d;put from to resolver')) + init-resolver + (list;zip2 env-vars env)) + (L/fold (function [var resolver'] + (d;put var var resolver')) + init-resolver + env-vars))] + (case (recur num-args resolver' bodyA) + (#ls;Function args' env' bodyS') + (#ls;Function (n.inc args') env bodyS') + + bodyS + (#ls;Function +1 env bodyS))) + (#la;Apply _) - (let [[funcA argsA] (unfold-apply exprA) - funcS (recur +0 local-offset false funcA) - argsS (L/map (recur +0 local-offset false) argsA)] + (let [[funcA argsA] (&&function;unfold-apply exprA) + funcS (recur +0 resolver funcA) + argsS (L/map (recur +0 resolver) argsA)] (case funcS - ## (^multi (#ls;Relative idx) - ## (and (|> num-args n.dec nat-to-int (i.* -1) (i.= idx)) + ## (^multi (#ls;Variable idx) + ## (and (|> scope-args n.dec nat-to-int (i.* -1) (i.= idx)) ## tail?)) ## (#ls;Recur +1 argsS) - ## (^multi (#ls;Function _num-args _scope _bodyS) - ## (and (n.= _num-args (list;size argsS)) + ## (^multi (#ls;Function _scope-args _scope _bodyS) + ## (and (n.= _scope-args (list;size argsS)) ## (not (has-self-reference? _bodyS)))) ## (#ls;Loop local-offset argsS (shift-loop-variables local-offset _bodyS)) @@ -182,59 +187,34 @@ (#ls;Call funcS argsS))) (#la;Procedure name args) - (#ls;Procedure name (L/map (recur +0 local-offset false) args)) + (#ls;Procedure name (L/map (recur +0 resolver) args)) _ (undefined) - ## (#la;Relative ref) - ## (case ref - ## (#;Local local) - ## (case local - ## +0 - ## (if (n.> +1 num-args) - ## (<| (#ls;Call (#ls;Relative 0)) - ## (L/map (|>. #ls;Relative)) - ## (list;range +1 (n.dec num-args))) - ## (#ls;Relative 0)) - - ## _ - ## (#ls;Relative (nat-to-int (n.+ (n.inc num-args) local)))) - - ## (#;Captured captured) - ## (#ls;Relative (|> captured nat-to-int (n.* -1) (n.+ -1)))) - - ## (#la;Function scope bodyA) - ## (case (recur (n.inc num-args) local-offset true bodyA) - ## (#ls;Function num-args' scope' bodyS') - ## (#ls;Function (n.inc num-args') scope bodyS') - - ## bodyS - ## (#ls;Function +1 scope bodyS)) - ## (#la;Case inputA branchesA) - ## (let [inputS (recur num-args local-offset false inputA)] + ## (let [inputS (recur +0 local-offset false inputA)] ## (case branchesA ## (^multi (^ (list [(#lp;Bind input-register) - ## (#la;Relative (#;Local output-register))])) + ## (#la;Variable (#;Local output-register))])) ## (n.= input-register output-register)) ## inputS ## (^ (list [(#lp;Bind register) bodyA])) - ## (#ls;Let register inputS (recur num-args local-offset tail? bodyA)) + ## (#ls;Let register inputS (recur +0 local-offset tail? bodyA)) ## (^or (^ (list [(#lp;Bool true) thenA] [(#lp;Bool false) elseA])) ## (^ (list [(#lp;Bool false) elseA] [(#lp;Bool true) thenA]))) ## (#ls;If inputS - ## (recur num-args local-offset tail? thenA) - ## (recur num-args local-offset tail? elseA)) + ## (recur +0 local-offset tail? thenA) + ## (recur +0 local-offset tail? elseA)) ## (#;Cons [headP headA] tailPA) - ## (let [headP+ (|> (recur num-args local-offset tail? headA) + ## (let [headP+ (|> (recur +0 local-offset tail? headA) ## #ls;ExecP ## (#ls;SeqP (&&case;path headP))) ## tailP+ (L/map (function [[pattern bodyA]] - ## (|> (recur num-args local-offset tail? bodyA) + ## (|> (recur +0 local-offset tail? bodyA) ## #ls;ExecP ## (#ls;SeqP (&&case;path pattern)))) ## tailPA)] diff --git a/new-luxc/source/luxc/synthesizer/function.lux b/new-luxc/source/luxc/synthesizer/function.lux new file mode 100644 index 000000000..be6a74da0 --- /dev/null +++ b/new-luxc/source/luxc/synthesizer/function.lux @@ -0,0 +1,55 @@ +(;module: + lux + (lux (data (coll [list "L/" Functor Fold]))) + (luxc (lang ["la" analysis] + ["ls" synthesis]))) + +(def: #export (environment scope) + (-> Scope (List ls;Variable)) + (|> scope + (get@ [#;captured #;mappings]) + (L/map (function [[_ _ ref]] + (case ref + (#;Local idx) + (nat-to-int idx) + + (#;Captured idx) + (|> idx n.inc nat-to-int (i.* -1)) + ))))) + +(do-template [ ] + [(def: #export ( var) + (-> ls;Variable Bool) + ( 0 var))] + + [function-var? i.=] + [local-var? i.>] + [captured-var? i.<] + ) + +(def: #export (nested-function? scope-args) + (-> Nat Bool) + (n.> +1 scope-args)) + +(def: #export (adjust-var scope-args var) + (-> Nat ls;Variable ls;Variable) + (|> scope-args n.dec nat-to-int (i.+ var))) + +(def: #export (to-captured idx) + (-> Nat Int) + (|> idx n.inc nat-to-int (i.* -1))) + +(def: #export (to-local idx) + (-> Nat Int) + (nat-to-int idx)) + +(def: #export (unfold-apply apply) + (-> la;Analysis [la;Analysis (List la;Analysis)]) + (loop [apply apply + args (list)] + (case apply + (#la;Apply arg func) + (recur func (#;Cons arg args)) + + _ + [apply args]))) diff --git a/new-luxc/source/luxc/synthesizer/structure.lux b/new-luxc/source/luxc/synthesizer/structure.lux new file mode 100644 index 000000000..403817c53 --- /dev/null +++ b/new-luxc/source/luxc/synthesizer/structure.lux @@ -0,0 +1,28 @@ +(;module: + lux + (luxc (lang ["la" analysis]))) + +(def: #export (unfold-tuple tuple) + (-> la;Analysis (List la;Analysis)) + (case tuple + (#la;Product left right) + (#;Cons left (unfold-tuple right)) + + _ + (list tuple))) + +(def: #export (unfold-variant variant) + (-> (Either la;Analysis la;Analysis) [Nat Bool la;Analysis]) + (loop [so-far +0 + variantA variant] + (case variantA + (#;Left valueA) + (case valueA + (#la;Sum choice) + (recur (n.inc so-far) choice) + + _ + [so-far false valueA]) + + (#;Right valueA) + [(n.inc so-far) true valueA]))) -- cgit v1.2.3