aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
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
-rw-r--r--new-luxc/test/test/luxc/synthesizer/function.lux127
5 files changed, 293 insertions, 105 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])))
diff --git a/new-luxc/test/test/luxc/synthesizer/function.lux b/new-luxc/test/test/luxc/synthesizer/function.lux
index 9243294a2..7c4776727 100644
--- a/new-luxc/test/test/luxc/synthesizer/function.lux
+++ b/new-luxc/test/test/luxc/synthesizer/function.lux
@@ -4,15 +4,138 @@
(control monad
pipe)
(data [product]
- (coll [list]))
+ [number]
+ text/format
+ (coll [list "L/" Functor<List> Fold<List>]
+ ["D" dict]
+ ["s" set]))
["r" math/random "r/" Monad<Random>]
test)
(luxc (lang ["la" analysis]
["ls" synthesis])
(analyser [";A" structure])
- [synthesizer])
+ [synthesizer]
+ (synthesizer ["&&;" function]))
(.. common))
+(def: (reference var)
+ (-> ls;Variable Ref)
+ (if (&&function;captured-var? var)
+ (#;Captured (|> var (i.* -1) int-to-nat n.dec))
+ (#;Local (int-to-nat var))))
+
+(def: (make-scope env)
+ (-> (List ls;Variable) Scope)
+ {#;name (list)
+ #;inner +0
+ #;locals {#;counter +0 #;mappings (list)}
+ #;captured {#;counter +0
+ #;mappings (L/map (|>. reference [Void] [""])
+ env)}})
+
+(def: gen-function//constant
+ (r;Random [Nat la;Analysis la;Analysis])
+ (r;rec
+ (function [gen-function//constant]
+ (do r;Monad<Random>
+ [function? r;bool]
+ (if function?
+ (do @
+ [[num-args outputA subA] gen-function//constant]
+ (wrap [(n.inc num-args)
+ outputA
+ (#la;Function (make-scope (list)) subA)]))
+ (do @
+ [outputA gen-primitive]
+ (wrap [+0 outputA outputA])))))))
+
+(def: (pick scope-size)
+ (-> Nat (r;Random Nat))
+ (|> r;nat (:: r;Monad<Random> map (n.% scope-size))))
+
+(def: gen-function//captured
+ (r;Random [Nat Int la;Analysis])
+ (do r;Monad<Random>
+ [num-locals (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10))))
+ #let [indices (list;n.range +0 (n.dec num-locals))
+ absolute-env (L/map &&function;to-local indices)
+ relative-env (L/map &&function;to-captured indices)]
+ [total-args prediction bodyA] (: (r;Random [Nat Int la;Analysis])
+ (loop [num-args +1
+ global-env relative-env]
+ (let [env-size (list;size global-env)
+ resolver (L/fold (function [[idx var] resolver]
+ (D;put idx var resolver))
+ (: (D;Dict Nat Int)
+ (D;new number;Hash<Nat>))
+ (list;zip2 (list;n.range +0 (n.dec env-size))
+ global-env))]
+ (do @
+ [nest? r;bool]
+ (if nest?
+ (do @
+ [num-picks (:: @ map (n.max +1) (pick (n.inc env-size)))
+ picks (|> (r;set number;Hash<Nat> num-picks (pick env-size))
+ (:: @ map s;to-list))
+ [total-args prediction bodyA] (recur (n.inc num-args)
+ (L/map (function [pick] (assume (list;nth pick global-env)))
+ picks))]
+ (wrap [total-args prediction (#la;Function (make-scope (L/map &&function;to-captured picks))
+ bodyA)]))
+ (do @
+ [chosen (pick (list;size global-env))]
+ (wrap [num-args
+ (assume (D;get chosen resolver))
+ (#la;Relative (#;Captured chosen))])))))))]
+ (wrap [total-args prediction (#la;Function (make-scope absolute-env) bodyA)])
+ ))
+
+(def: gen-function//local
+ (r;Random [Nat Int la;Analysis])
+ (loop [num-args +0
+ nest? true]
+ (if nest?
+ (do r;Monad<Random>
+ [nest?' r;bool
+ [total-args prediction bodyA] (recur (n.inc num-args) nest?')]
+ (wrap [total-args prediction (#la;Function (make-scope (list)) bodyA)]))
+ (do r;Monad<Random>
+ [chosen (|> r;nat (:: @ map (|>. (n.% +100) (n.max +2))))]
+ (wrap [num-args
+ (|> chosen (n.+ (n.dec num-args)) nat-to-int)
+ (#la;Relative (#;Local chosen))])))))
+
+(test: "Function definition."
+ [[args1 prediction1 function1] gen-function//constant
+ [args2 prediction2 function2] gen-function//captured
+ [args3 prediction3 function3] gen-function//local]
+ ($_ seq
+ (assert "Nested functions will get folded together."
+ (|> (synthesizer;synthesize function1)
+ (case> (#ls;Function args captured output)
+ (and (n.= args1 args)
+ (corresponds? prediction1 output))
+
+ _
+ (n.= +0 args1))))
+ (assert "Folded functions provide direct access to captured variables."
+ (|> (synthesizer;synthesize function2)
+ (case> (#ls;Function args captured (#ls;Variable output))
+ (and (n.= args2 args)
+ (i.= prediction2 output))
+
+ _
+ false)))
+ (assert "Folded functions properly offset local variables."
+ (|> (synthesizer;synthesize function3)
+ (case> (#ls;Function args captured (#ls;Variable output))
+ (and (n.= args3 args)
+ (i.= prediction3 output))
+
+ _
+ false)))
+ ))
+
(test: "Function application."
[num-args (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1))))
funcA gen-primitive
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 04:00:58 +0000