aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc
diff options
context:
space:
mode:
authorEduardo Julian2017-06-06 20:23:15 -0400
committerEduardo Julian2017-06-06 20:23:15 -0400
commit4480e41e949ba3ba0c9bceeed43e3f144f82103b (patch)
treee31476d83b24a55746738c0b0b5100931ce289c3 /new-luxc/source/luxc
parentaa3dcb411db1bfbf41ca59c334c6c792b9e40d0c (diff)
- Now optimizing functions.
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/synthesis.lux8
-rw-r--r--new-luxc/source/luxc/synthesizer.lux180
-rw-r--r--new-luxc/source/luxc/synthesizer/function.lux55
-rw-r--r--new-luxc/source/luxc/synthesizer/structure.lux28
4 files changed, 168 insertions, 103 deletions
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<List>])))
+ (lux (data text/format
+ [number]
+ (coll [list "L/" Functor<List> Fold<List>]
+ ["d" dict])))
(luxc ["&" base]
(lang ["la" analysis]
["ls" synthesis])
- ## (synthesizer ["&&;" case])
+ (synthesizer ["&&;" structure]
+ ["&&;" function])
))
-## (do-template [<name> <comp>]
-## [(def: (<name> ref)
-## (-> Int Bool)
-## (<comp> 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<Int>))
+
(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 [<from> <to>]
@@ -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<List> Fold<List>])))
+ (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 [<name> <comp>]
+ [(def: #export (<name> var)
+ (-> ls;Variable Bool)
+ (<comp> 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])))