aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/synthesizer
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/synthesizer.lux167
-rw-r--r--new-luxc/source/luxc/synthesizer/case.lux96
-rw-r--r--new-luxc/source/luxc/synthesizer/loop.lux224
3 files changed, 271 insertions, 216 deletions
diff --git a/new-luxc/source/luxc/synthesizer.lux b/new-luxc/source/luxc/synthesizer.lux
index 011dfd8ae..e1eb67bd7 100644
--- a/new-luxc/source/luxc/synthesizer.lux
+++ b/new-luxc/source/luxc/synthesizer.lux
@@ -1,11 +1,15 @@
(;module:
lux
- (lux (data [maybe]
+ (lux (control ["p" parser])
+ (data [maybe]
+ ["e" error]
[number]
[product]
text/format
(coll [list "list/" Functor<List> Fold<List> Monoid<List>]
- [dict #+ Dict])))
+ [dict #+ Dict]))
+ (meta [code]
+ ["s" syntax]))
(luxc ["&" base]
(lang ["la" analysis]
["ls" synthesis])
@@ -24,6 +28,76 @@
body
(&&loop;reify-recursion arity body)))
+(def: (parse-environment env)
+ (-> (List Code) (e;Error (List ls;Variable)))
+ (s;run env (p;some s;int)))
+
+(def: (let$ register inputS bodyS)
+ (-> Nat ls;Synthesis ls;Synthesis ls;Synthesis)
+ (` ("lux let" (~ (code;nat register)) (~ inputS) (~ bodyS))))
+
+(def: (if$ testS thenS elseS)
+ (-> ls;Synthesis ls;Synthesis ls;Synthesis ls;Synthesis)
+ (` ("lux if" (~ testS)
+ (~ thenS)
+ (~ elseS))))
+
+(def: (function$ arity environment body)
+ (-> ls;Arity (List ls;Variable) ls;Synthesis ls;Synthesis)
+ (` ("lux function" (~ (code;nat arity))
+ [(~@ (list/map code;int environment))]
+ (~ body))))
+
+(def: (variant$ tag last? valueS)
+ (-> Nat Bool ls;Synthesis ls;Synthesis)
+ (` ((~ (code;nat tag)) (~ (code;bool last?)) (~ valueS))))
+
+(def: (var$ var)
+ (-> ls;Variable ls;Synthesis)
+ (` ((~ (code;int var)))))
+
+(def: (procedure$ name argsS)
+ (-> Text (List ls;Synthesis) ls;Synthesis)
+ (` ((~ (code;text name)) (~@ argsS))))
+
+(def: (call$ funcS argsS)
+ (-> ls;Synthesis (List ls;Synthesis) ls;Synthesis)
+ (` ("lux call" (~ funcS) (~@ argsS))))
+
+(def: (synthesize-case synthesize inputA branchesA)
+ (-> (-> la;Analysis ls;Synthesis)
+ la;Analysis (List [la;Pattern la;Analysis])
+ ls;Synthesis)
+ (let [inputS (synthesize inputA)]
+ (case (list;reverse branchesA)
+ (^multi (^ (list [(#la;BindP input-register)
+ (#la;Variable (#;Local output-register))]))
+ (n.= input-register output-register))
+ inputS
+
+ (^ (list [(#la;BindP register) bodyA]))
+ (let$ register inputS (synthesize bodyA))
+
+ (^or (^ (list [(#la;BoolP true) thenA] [(#la;BoolP false) elseA]))
+ (^ (list [(#la;BoolP false) elseA] [(#la;BoolP true) thenA])))
+ (if$ inputS (synthesize thenA) (synthesize elseA))
+
+ (#;Cons [lastP lastA] prevsPA)
+ (let [transform-branch (: (-> la;Pattern la;Analysis ls;Path)
+ (function [pattern expr]
+ (|> (synthesize expr)
+ (~) ("lux case exec")
+ ("lux case seq" (~ (&&case;path pattern)))
+ (`))))]
+ (` ("lux case" (~ inputS)
+ (~ (list/fold &&case;weave
+ (transform-branch lastP lastA)
+ (list/map (product;uncurry transform-branch) prevsPA))))))
+
+ _
+ (undefined)
+ )))
+
(def: #export (synthesize analysis)
(-> la;Analysis ls;Synthesis)
(loop [outer-arity +0
@@ -31,71 +105,43 @@
num-locals +0
exprA analysis]
(case exprA
+ #la;Unit
+ (' [])
+
(^template [<from> <to>]
(<from> value)
(<to> value))
- ([#la;Unit #ls;Unit]
- [#la;Bool #ls;Bool]
- [#la;Nat #ls;Nat]
- [#la;Int #ls;Int]
- [#la;Deg #ls;Deg]
- [#la;Frac #ls;Frac]
- [#la;Text #ls;Text]
- [#la;Definition #ls;Definition])
+ ([#la;Bool code;bool]
+ [#la;Nat code;nat]
+ [#la;Int code;int]
+ [#la;Deg code;deg]
+ [#la;Frac code;frac]
+ [#la;Text code;text]
+ [#la;Definition code;symbol])
(#la;Product _)
- (#ls;Tuple (list/map (recur +0 resolver num-locals) (&&structure;unfold-tuple exprA)))
+ (` [(~@ (list/map (recur +0 resolver num-locals) (&&structure;unfold-tuple exprA)))])
(#la;Sum choice)
(let [[tag last? value] (&&structure;unfold-variant choice)]
- (#ls;Variant tag last? (recur +0 resolver num-locals value)))
+ (variant$ tag last? (recur +0 resolver num-locals value)))
(#la;Variable ref)
(case ref
(#;Local register)
(if (&&function;nested? outer-arity)
(if (n.= +0 register)
- (#ls;Call (|> (list;n.range +1 (n.dec outer-arity))
- (list/map (|>. &&function;to-local #ls;Variable)))
- (#ls;Variable 0))
- (#ls;Variable (&&function;adjust-var outer-arity (&&function;to-local register))))
- (#ls;Variable (&&function;to-local register)))
+ (call$ (var$ 0) (|> (list;n.range +1 (n.dec outer-arity))
+ (list/map (|>. &&function;to-local code;int (~) () (`)))))
+ (var$ (&&function;adjust-var outer-arity (&&function;to-local register))))
+ (var$ (&&function;to-local register)))
(#;Captured register)
- (#ls;Variable (let [var (&&function;to-captured register)]
- (maybe;default var (dict;get var resolver)))))
+ (var$ (let [var (&&function;to-captured register)]
+ (maybe;default var (dict;get var resolver)))))
(#la;Case inputA branchesA)
- (let [inputS (recur +0 resolver num-locals inputA)]
- (case (list;reverse branchesA)
- (^multi (^ (list [(#la;BindP input-register)
- (#la;Variable (#;Local output-register))]))
- (n.= input-register output-register))
- inputS
-
- (^ (list [(#la;BindP register) bodyA]))
- (#ls;Let register inputS (recur +0 resolver num-locals bodyA))
-
- (^or (^ (list [(#la;BoolP true) thenA] [(#la;BoolP false) elseA]))
- (^ (list [(#la;BoolP false) elseA] [(#la;BoolP true) thenA])))
- (#ls;If inputS
- (recur +0 resolver num-locals thenA)
- (recur +0 resolver num-locals elseA))
-
- (#;Cons [lastP lastA] prevsPA)
- (let [transform-branch (: (-> la;Pattern la;Analysis ls;Path)
- (function [pattern expr]
- (|> (recur +0 resolver num-locals expr)
- #ls;ExecP
- (#ls;SeqP (&&case;path pattern)))))]
- (#ls;Case inputS
- (list/fold &&case;weave
- (transform-branch lastP lastA)
- (list/map (product;uncurry transform-branch) prevsPA))))
-
- _
- (undefined)
- ))
+ (synthesize-case (recur +0 resolver num-locals) inputA branchesA)
(#la;Function scope bodyA)
(let [inner-arity (n.inc outer-arity)
@@ -116,33 +162,34 @@
init-resolver
env-vars))]
(case (recur inner-arity resolver' +0 bodyA)
- (#ls;Function arity' env' bodyS')
+ (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat arity')] env' bodyS'))])
(let [arity (n.inc arity')]
- (#ls;Function arity env (prepare-body inner-arity arity bodyS')))
+ (function$ arity env (prepare-body inner-arity arity bodyS')))
bodyS
- (#ls;Function +1 env (prepare-body inner-arity +1 bodyS))))
+ (function$ +1 env (prepare-body inner-arity +1 bodyS))))
(#la;Apply _)
(let [[funcA argsA] (&&function;unfold-apply exprA)
funcS (recur +0 resolver num-locals funcA)
argsS (list/map (recur +0 resolver num-locals) argsA)]
(case funcS
- (^multi (#ls;Function _arity _env _bodyS)
+ (^multi (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat _arity)] [_ (#;Tuple _env)] _bodyS))])
(and (n.= _arity (list;size argsS))
- (not (&&loop;contains-self-reference? _bodyS))))
+ (not (&&loop;contains-self-reference? _bodyS)))
+ [(parse-environment _env) (#e;Success _env)])
(let [register-offset (if (&&function;top? outer-arity)
num-locals
(|> outer-arity n.inc (n.+ num-locals)))]
- (#ls;Loop register-offset argsS
- (&&loop;adjust _env register-offset _bodyS)))
+ (` ("lux loop" (~ (code;nat register-offset)) [(~@ argsS)]
+ (~ (&&loop;adjust _env register-offset _bodyS)))))
- (#ls;Call argsS' funcS')
- (#ls;Call (list/compose argsS' argsS) funcS')
+ (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS' argsS'))])
+ (call$ funcS' (list/compose argsS' argsS))
_
- (#ls;Call argsS funcS)))
+ (call$ funcS argsS)))
(#la;Procedure name args)
- (#ls;Procedure name (list/map (recur +0 resolver num-locals) args))
+ (procedure$ name (list/map (recur +0 resolver num-locals) args))
)))
diff --git a/new-luxc/source/luxc/synthesizer/case.lux b/new-luxc/source/luxc/synthesizer/case.lux
index 02b1bfba5..91f339bdf 100644
--- a/new-luxc/source/luxc/synthesizer/case.lux
+++ b/new-luxc/source/luxc/synthesizer/case.lux
@@ -1,10 +1,10 @@
(;module:
lux
- (lux (data [bool "B/" Eq<Bool>]
- [text "T/" Eq<Text>]
+ (lux (data [bool "bool/" Eq<Bool>]
+ [text "text/" Eq<Text>]
[number]
- (coll [list "L/" Functor<List> Fold<List> Monoid<List>]
- ["s" set])))
+ (coll [list "list/" Fold<List>]))
+ (meta [code "code/" Eq<Code>]))
(luxc (lang ["la" analysis]
["ls" synthesis])
(synthesizer ["&;" function])))
@@ -12,21 +12,23 @@
(def: #export (path pattern)
(-> la;Pattern ls;Path)
(case pattern
+ (#la;BindP register)
+ (` ("lux case bind" (~ (code;nat register))))
+
(^template [<from> <to>]
- (<from> register)
- (<to> register))
- ([#la;BindP #ls;BindP]
- [#la;BoolP #ls;BoolP]
- [#la;NatP #ls;NatP]
- [#la;IntP #ls;IntP]
- [#la;DegP #ls;DegP]
- [#la;FracP #ls;FracP]
- [#la;TextP #ls;TextP])
+ (<from> value)
+ (<to> value))
+ ([#la;BoolP code;bool]
+ [#la;NatP code;nat]
+ [#la;IntP code;int]
+ [#la;DegP code;deg]
+ [#la;FracP code;frac]
+ [#la;TextP code;text])
(#la;TupleP membersP)
(case (list;reverse membersP)
#;Nil
- #ls;UnitP
+ (' ("lux case pop"))
(#;Cons singletonP #;Nil)
(path singletonP)
@@ -34,58 +36,46 @@
(#;Cons lastP prevsP)
(let [length (list;size membersP)
last-idx (n.dec length)
- last-path (#ls;TupleP (#;Right last-idx) (path lastP))
- [_ tuple-path] (L/fold (function [current-pattern [current-idx next-path]]
- [(n.dec current-idx)
- (#ls;SeqP (#ls;TupleP (#;Left current-idx)
- (path current-pattern))
- next-path)])
- [(n.dec last-idx) last-path]
- prevsP)]
+ [_ tuple-path] (list/fold (function [current-pattern [current-idx next-path]]
+ [(n.dec current-idx)
+ (` ("lux case seq"
+ ("lux case tuple left" (~ (code;nat current-idx)) (~ (path current-pattern)))
+ (~ next-path)))])
+ [(n.dec last-idx)
+ (` ("lux case tuple right" (~ (code;nat last-idx)) (~ (path lastP))))]
+ prevsP)]
tuple-path))
(#la;VariantP tag num-tags memberP)
- (let [last? (n.= (n.dec num-tags) tag)]
- (#ls;VariantP (if last? (#;Right tag) (#;Left tag))
- (path 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)))))))
(def: #export (weave leftP rightP)
(-> ls;Path ls;Path ls;Path)
- (with-expansions [<default> (as-is (#ls;AltP leftP rightP))]
+ (with-expansions [<default> (as-is (` ("lux case alt" (~ leftP) (~ rightP))))]
(case [leftP rightP]
- [#ls;UnitP #ls;UnitP]
- #ls;UnitP
-
- (^template [<tag> <test>]
- [(<tag> left) (<tag> right)]
- (if (<test> left right)
- leftP
- <default>))
- ([#ls;BindP n.=]
- [#ls;BoolP B/=]
- [#ls;NatP n.=]
- [#ls;IntP i.=]
- [#ls;DegP d.=]
- [#ls;FracP f.=]
- [#ls;TextP T/=])
-
- (^template [<tag> <side>]
- [(<tag> (<side> left-idx) left-then) (<tag> (<side> right-idx) right-then)]
+ (^template [<special>]
+ (^ [[_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat left-idx)] left-then))]
+ [_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat right-idx)] right-then))]])
(if (n.= left-idx right-idx)
- (weave left-then right-then)
+ (` (<special> (~ (code;nat left-idx)) (~ (weave left-then right-then))))
<default>))
- ([#ls;TupleP #;Left]
- [#ls;TupleP #;Right]
- [#ls;VariantP #;Left]
- [#ls;VariantP #;Right])
+ (["lux case tuple left"]
+ ["lux case tuple right"]
+ ["lux case variant left"]
+ ["lux case variant right"])
- [(#ls;SeqP left-pre left-post) (#ls;SeqP right-pre right-post)]
+ (^ [[_ (#;Form (list [_ (#;Text "lux case seq")] left-pre left-post))]
+ [_ (#;Form (list [_ (#;Text "lux case seq")] right-pre right-post))]])
(case (weave left-pre right-pre)
- (#ls;AltP _ _)
+ (^ [_ (#;Form (list [_ (#;Text "lux case alt")] _ _))])
<default>
weavedP
- (#ls;SeqP weavedP (weave left-post right-post)))
+ (` ("lux case seq" (~ weavedP) (~ (weave left-post right-post)))))
_
- <default>)))
+ (if (code/= leftP rightP)
+ leftP
+ <default>))))
diff --git a/new-luxc/source/luxc/synthesizer/loop.lux b/new-luxc/source/luxc/synthesizer/loop.lux
index ad4504f41..8599db981 100644
--- a/new-luxc/source/luxc/synthesizer/loop.lux
+++ b/new-luxc/source/luxc/synthesizer/loop.lux
@@ -1,61 +1,71 @@
(;module:
lux
- (lux (data [maybe]
- text/format
- (coll [list "L/" Functor<List>])))
+ (lux (control [monad #+ do]
+ ["p" parser])
+ (data [maybe]
+ (coll [list "list/" Functor<List>]))
+ (meta [code]
+ [syntax]))
(luxc (lang ["ls" synthesis])
(synthesizer ["&&;" function])))
(def: #export (contains-self-reference? exprS)
(-> ls;Synthesis Bool)
(case exprS
- (#ls;Variant tag last? memberS)
+ (^ [_ (#;Form (list [_ (#;Nat tag)] [_ (#;Bool last?)] memberS))])
(contains-self-reference? memberS)
- (#ls;Tuple membersS)
+ [_ (#;Tuple membersS)]
(list;any? contains-self-reference? membersS)
- (#ls;Case inputS pathS)
+ (^ [_ (#;Form (list [_ (#;Int var)]))])
+ (&&function;self? var)
+
+ (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
(or (contains-self-reference? inputS)
(loop [pathS pathS]
(case pathS
- (^or (#ls;AltP leftS rightS)
- (#ls;SeqP leftS rightS))
+ (^or (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))])
+ (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))]))
(or (recur leftS)
(recur rightS))
-
- (#ls;ExecP bodyS)
+
+ (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
(contains-self-reference? bodyS)
_
false)))
- (#ls;Function arity environment bodyS)
- (list;any? &&function;self? environment)
-
- (#ls;Call argsS funcS)
+ (^ [_ (#;Form (list [_ (#;Text "lux function")] arity [_ (#;Tuple environment)] bodyS))])
+ (list;any? (function [captured]
+ (case captured
+ (^ [_ (#;Form (list [_ (#;Int var)]))])
+ (&&function;self? var)
+
+ _
+ false))
+ environment)
+
+ (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))])
(or (contains-self-reference? funcS)
(list;any? contains-self-reference? argsS))
-
- (^or (#ls;Recur argsS)
- (#ls;Procedure name argsS))
- (list;any? contains-self-reference? argsS)
-
- (#ls;Variable idx)
- (&&function;self? idx)
- (#ls;Let register inputS bodyS)
+ (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))])
(or (contains-self-reference? inputS)
(contains-self-reference? bodyS))
- (#ls;If inputS thenS elseS)
+ (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
(or (contains-self-reference? inputS)
(contains-self-reference? thenS)
(contains-self-reference? elseS))
- (#ls;Loop offset argsS bodyS)
- (or (list;any? contains-self-reference? argsS)
+ (^ [_ (#;Form (list [_ (#;Text "lux loop")] offset [_ (#;Tuple initsS)] bodyS))])
+ (or (list;any? contains-self-reference? initsS)
(contains-self-reference? bodyS))
+
+ (^or (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))])
+ (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))]))
+ (list;any? contains-self-reference? argsS)
_
false
@@ -65,37 +75,34 @@
(-> Nat ls;Synthesis ls;Synthesis)
(loop [exprS exprS]
(case exprS
- (#ls;Case inputS pathS)
- (#ls;Case inputS
- (let [reify-recursion' recur]
- (loop [pathS pathS]
- (case pathS
- (#ls;AltP leftS rightS)
- (#ls;AltP (recur leftS) (recur rightS))
-
- (#ls;SeqP leftS rightS)
- (#ls;SeqP leftS (recur rightS))
-
- (#ls;ExecP bodyS)
- (#ls;ExecP (reify-recursion' bodyS))
-
- _
- pathS))))
-
- (^multi (#ls;Call argsS (#ls;Variable 0))
+ (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
+ (` ("lux case" (~ inputS)
+ (~ (let [reify-recursion' recur]
+ (loop [pathS pathS]
+ (case pathS
+ (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))])
+ (` ("lux case alt" (~ (recur leftS)) (~ (recur rightS))))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))])
+ (` ("lux case seq" (~ leftS) (~ (recur rightS))))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
+ (` ("lux case exec" (~ (reify-recursion' bodyS))))
+
+ _
+ pathS))))))
+
+ (^multi (^ [_ (#;Form (list& [_ (#;Text "lux call")]
+ [_ (#;Form (list [_ (#;Int 0)]))]
+ argsS))])
(n.= arity (list;size argsS)))
- (#ls;Recur argsS)
+ (` ("lux recur" (~@ argsS)))
- (#ls;Call argsS (#ls;Variable var))
- exprS
+ (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))])
+ (` ("lux let" (~ register) (~ inputS) (~ (recur bodyS))))
- (#ls;Let register inputS bodyS)
- (#ls;Let register inputS (recur bodyS))
-
- (#ls;If inputS thenS elseS)
- (#ls;If inputS
- (recur thenS)
- (recur elseS))
+ (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
+ (` ("lux if" (~ inputS) (~ (recur thenS)) (~ (recur elseS))))
_
exprS
@@ -109,58 +116,69 @@
(|> env (list;nth idx) maybe;assume))))]
(loop [exprS exprS]
(case exprS
- (#ls;Variant tag last? valueS)
- (#ls;Variant tag last? (recur valueS))
+ (^ [_ (#;Form (list [_ (#;Nat tag)] last? valueS))])
+ (` ((~ (code;nat tag)) (~ last?) (~ (recur valueS))))
- (#ls;Tuple members)
- (#ls;Tuple (L/map recur members))
-
- (#ls;Case inputS pathS)
- (#ls;Case (recur inputS)
- (let [adjust' recur]
- (loop [pathS pathS]
- (case pathS
- (^template [<tag>]
- (<tag> leftS rightS)
- (<tag> (recur leftS) (recur rightS)))
- ([#ls;AltP]
- [#ls;SeqP])
-
- (#ls;ExecP bodyS)
- (#ls;ExecP (adjust' bodyS))
-
- _
- pathS))))
-
- (#ls;Function arity scope bodyS)
- (#ls;Function arity
- (L/map resolve-captured scope)
- (recur bodyS))
-
- (#ls;Call argsS funcS)
- (#ls;Call (L/map recur argsS) (recur funcS))
-
- (#ls;Recur argsS)
- (#ls;Recur (L/map recur argsS))
-
- (#ls;Procedure name argsS)
- (#ls;Procedure name (L/map recur argsS))
-
- (#ls;Variable var)
- (if (&&function;captured? var)
- (#ls;Variable (resolve-captured var))
- (#ls;Variable (|> outer-offset nat-to-int (i.+ var))))
-
- (#ls;Let register inputS bodyS)
- (#ls;Let (n.+ outer-offset register) (recur inputS) (recur bodyS))
-
- (#ls;If inputS thenS elseS)
- (#ls;If (recur inputS) (recur thenS) (recur elseS))
+ [_ (#;Tuple members)]
+ [_ (#;Tuple (list/map recur members))]
+
+ (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
+ (` ("lux case" (~ (recur inputS))
+ (~ (let [adjust' recur]
+ (loop [pathS pathS]
+ (case pathS
+ (^template [<pattern>]
+ (^ [_ (#;Form (list [_ (#;Text <pattern>)] leftS rightS))])
+ (` (<pattern> (~ (recur leftS)) (~ (recur rightS)))))
+ (["lux case alt"]
+ ["lux case seq"])
+
+ (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
+ (` ("lux case exec" (~ (adjust' bodyS))))
+
+ _
+ pathS))))))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux function")] arity [_ (#;Tuple environment)] bodyS))])
+ (` ("lux function" (~ arity)
+ (~ [_ (#;Tuple (list/map (function [_var]
+ (case _var
+ (^ [_ (#;Form (list [_ (#;Int var)]))])
+ (` ((~ (code;int (resolve-captured var)))))
+
+ _
+ _var))
+ environment))])
+ (~ (recur bodyS))))
+
+ (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))])
+ (` ("lux call" (~ (recur funcS)) (~@ (list/map recur argsS))))
+
+ (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))])
+ (` ("lux recur" (~@ (list/map recur argsS))))
+
+ (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))])
+ (` ((~ (code;text procedure)) (~@ (list/map recur argsS))))
- (#ls;Loop inner-offset argsS bodyS)
- (#ls;Loop (n.+ outer-offset inner-offset)
- (L/map recur argsS)
- (recur bodyS))
+ (^ [_ (#;Form (list [_ (#;Int var)]))])
+ (if (&&function;captured? var)
+ (` ((~ (code;int (resolve-captured var)))))
+ (` ((~ (code;int (|> outer-offset nat-to-int (i.+ var)))))))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux let")] [_ (#;Nat register)] inputS bodyS))])
+ (` ("lux let" (~ (code;nat (n.+ outer-offset register)))
+ (~ (recur inputS))
+ (~ (recur bodyS))))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
+ (` ("lux if" (~ (recur inputS))
+ (~ (recur thenS))
+ (~ (recur elseS))))
+
+ (^ [_ (#;Form (list [_ (#;Text "lux loop")] [_ (#;Nat inner-offset)] [_ (#;Tuple initsS)] bodyS))])
+ (` ("lux loop" (~ (code;nat (n.+ outer-offset inner-offset)))
+ [(~@ (list/map recur initsS))]
+ (~ (recur bodyS))))
_
exprS
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 12:00:12 +0000