aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc')
-rw-r--r--new-luxc/source/luxc/analyser.lux1
-rw-r--r--new-luxc/source/luxc/analyser/case.lux2
-rw-r--r--new-luxc/source/luxc/analyser/case/coverage.lux2
-rw-r--r--new-luxc/source/luxc/analyser/primitive.lux1
-rw-r--r--new-luxc/source/luxc/generator/expr.jvm.lux1
-rw-r--r--new-luxc/source/luxc/generator/host/jvm/def.lux2
-rw-r--r--new-luxc/source/luxc/generator/host/jvm/inst.lux4
-rw-r--r--new-luxc/source/luxc/generator/host/jvm/type.lux2
-rw-r--r--new-luxc/source/luxc/generator/primitive.jvm.lux1
-rw-r--r--new-luxc/source/luxc/lang/analysis.lux6
-rw-r--r--new-luxc/source/luxc/lang/synthesis.lux10
-rw-r--r--new-luxc/source/luxc/module/descriptor/annotation.lux3
-rw-r--r--new-luxc/source/luxc/module/descriptor/common.lux9
-rw-r--r--new-luxc/source/luxc/module/descriptor/type.lux1
-rw-r--r--new-luxc/source/luxc/parser.lux65
-rw-r--r--new-luxc/source/luxc/synthesizer.lux67
-rw-r--r--new-luxc/source/luxc/synthesizer/case.lux91
-rw-r--r--new-luxc/source/luxc/synthesizer/function.lux4
-rw-r--r--new-luxc/source/luxc/synthesizer/variable.lux100
19 files changed, 263 insertions, 109 deletions
diff --git a/new-luxc/source/luxc/analyser.lux b/new-luxc/source/luxc/analyser.lux
index e79b74f01..799e2365d 100644
--- a/new-luxc/source/luxc/analyser.lux
+++ b/new-luxc/source/luxc/analyser.lux
@@ -53,7 +53,6 @@
[#;Int &&primitive;analyse-int]
[#;Deg &&primitive;analyse-deg]
[#;Real &&primitive;analyse-real]
- [#;Char &&primitive;analyse-char]
[#;Text &&primitive;analyse-text])
(^ (#;Tuple (list)))
diff --git a/new-luxc/source/luxc/analyser/case.lux b/new-luxc/source/luxc/analyser/case.lux
index 7d580f3b4..30d0a2b7a 100644
--- a/new-luxc/source/luxc/analyser/case.lux
+++ b/new-luxc/source/luxc/analyser/case.lux
@@ -4,7 +4,6 @@
eq)
(data [bool "B/" Eq<Bool>]
[number]
- [char]
[text]
text/format
[product]
@@ -104,7 +103,6 @@
[Int #;Int #la;IntP]
[Deg #;Deg #la;DegP]
[Real #;Real #la;RealP]
- [Char #;Char #la;CharP]
[Text #;Text #la;TextP])
(^ [cursor (#;Tuple (list))])
diff --git a/new-luxc/source/luxc/analyser/case/coverage.lux b/new-luxc/source/luxc/analyser/case/coverage.lux
index 5989952ee..88e40ac0f 100644
--- a/new-luxc/source/luxc/analyser/case/coverage.lux
+++ b/new-luxc/source/luxc/analyser/case/coverage.lux
@@ -54,7 +54,7 @@
## Primitive patterns always have partial coverage because there
## are too many possibilities as far as values go.
(^or (#la;NatP _) (#la;IntP _) (#la;DegP _)
- (#la;RealP _) (#la;CharP _) (#la;TextP _))
+ (#la;RealP _) (#la;TextP _))
#Partial
## Bools are the exception, since there is only "true" and
diff --git a/new-luxc/source/luxc/analyser/primitive.lux b/new-luxc/source/luxc/analyser/primitive.lux
index 26580a503..9102acda5 100644
--- a/new-luxc/source/luxc/analyser/primitive.lux
+++ b/new-luxc/source/luxc/analyser/primitive.lux
@@ -21,7 +21,6 @@
[analyse-int Int #la;Int]
[analyse-deg Deg #la;Deg]
[analyse-real Real #la;Real]
- [analyse-char Char #la;Char]
[analyse-text Text #la;Text]
)
diff --git a/new-luxc/source/luxc/generator/expr.jvm.lux b/new-luxc/source/luxc/generator/expr.jvm.lux
index 32291317f..32f8bde31 100644
--- a/new-luxc/source/luxc/generator/expr.jvm.lux
+++ b/new-luxc/source/luxc/generator/expr.jvm.lux
@@ -27,7 +27,6 @@
[#ls;Int &primitive;generate-int]
[#ls;Deg &primitive;generate-deg]
[#ls;Real &primitive;generate-real]
- [#ls;Char &primitive;generate-char]
[#ls;Text &primitive;generate-text])
(#ls;Variant tag tail? member)
diff --git a/new-luxc/source/luxc/generator/host/jvm/def.lux b/new-luxc/source/luxc/generator/host/jvm/def.lux
index 39fab2f2a..6f0f97d9b 100644
--- a/new-luxc/source/luxc/generator/host/jvm/def.lux
+++ b/new-luxc/source/luxc/generator/host/jvm/def.lux
@@ -255,7 +255,7 @@
[long-field Int $t;long id]
[float-field Real $t;float host;d2f]
[double-field Real $t;double id]
- [char-field Char $t;char id]
+ [char-field Nat $t;char (|>. nat-to-int host;l2i host;i2c)]
[string-field Text ($t;class "java.lang.String" (list)) id]
)
diff --git a/new-luxc/source/luxc/generator/host/jvm/inst.lux b/new-luxc/source/luxc/generator/host/jvm/inst.lux
index 82b360883..824598ab8 100644
--- a/new-luxc/source/luxc/generator/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/generator/host/jvm/inst.lux
@@ -1,5 +1,5 @@
(;module:
- lux
+ [lux #- char]
(lux [host #+ jvm-import do-to])
["$" ..]
(.. ["$t" type]))
@@ -122,7 +122,7 @@
[int Int host;l2i]
[long Int id]
[double Real id]
- [char Char id]
+ [char Nat (|>. nat-to-int host;l2i host;i2c)]
[string Text id]
)
diff --git a/new-luxc/source/luxc/generator/host/jvm/type.lux b/new-luxc/source/luxc/generator/host/jvm/type.lux
index b457ac636..3825d443b 100644
--- a/new-luxc/source/luxc/generator/host/jvm/type.lux
+++ b/new-luxc/source/luxc/generator/host/jvm/type.lux
@@ -1,5 +1,5 @@
(;module:
- lux
+ [lux #- char]
(lux (data [text]
text/format
(coll [list "L/" Functor<List>])))
diff --git a/new-luxc/source/luxc/generator/primitive.jvm.lux b/new-luxc/source/luxc/generator/primitive.jvm.lux
index c444f791d..2cb01a6aa 100644
--- a/new-luxc/source/luxc/generator/primitive.jvm.lux
+++ b/new-luxc/source/luxc/generator/primitive.jvm.lux
@@ -33,6 +33,5 @@
[generate-int Int $i;long $i;wrap-long]
[generate-deg Deg (|>. (:! Int) $i;long) $i;wrap-long]
[generate-real Real $i;double $i;wrap-double]
- [generate-char Char $i;char $i;wrap-char]
[generate-text Text $i;string id]
)
diff --git a/new-luxc/source/luxc/lang/analysis.lux b/new-luxc/source/luxc/lang/analysis.lux
index 2e122a526..308296086 100644
--- a/new-luxc/source/luxc/lang/analysis.lux
+++ b/new-luxc/source/luxc/lang/analysis.lux
@@ -4,16 +4,15 @@
(data (coll [list "L/" Fold<List>]))))
(type: #export #rec Pattern
- (#BindP Nat)
(#BoolP Bool)
(#NatP Nat)
(#IntP Int)
(#DegP Deg)
(#RealP Real)
- (#CharP Char)
(#TextP Text)
(#TupleP (List Pattern))
- (#VariantP Nat Nat Pattern))
+ (#VariantP Nat Nat Pattern)
+ (#BindP Nat))
(type: #export #rec Analysis
#Unit
@@ -22,7 +21,6 @@
(#Int Int)
(#Deg Deg)
(#Real Real)
- (#Char Char)
(#Text Text)
(#Sum (Either Analysis Analysis))
(#Product Analysis Analysis)
diff --git a/new-luxc/source/luxc/lang/synthesis.lux b/new-luxc/source/luxc/lang/synthesis.lux
index b86f49fb2..ad31d0138 100644
--- a/new-luxc/source/luxc/lang/synthesis.lux
+++ b/new-luxc/source/luxc/lang/synthesis.lux
@@ -6,17 +6,16 @@
(def: #export Variable Int)
(type: #export (Path' s)
- #PopP
- (#BindP Nat)
+ #UnitP
(#BoolP Bool)
(#NatP Nat)
(#IntP Int)
(#DegP Deg)
(#RealP Real)
- (#CharP Char)
(#TextP Text)
- (#VariantP (Either Nat Nat))
- (#TupleP (Either Nat Nat))
+ (#VariantP (Either Nat Nat) (Path' s))
+ (#TupleP (Either Nat Nat) (Path' s))
+ (#BindP Nat)
(#AltP (Path' s) (Path' s))
(#SeqP (Path' s) (Path' s))
(#ExecP s))
@@ -28,7 +27,6 @@
(#Int Int)
(#Deg Deg)
(#Real Real)
- (#Char Char)
(#Text Text)
(#Variant Nat Bool Synthesis)
(#Tuple (List Synthesis))
diff --git a/new-luxc/source/luxc/module/descriptor/annotation.lux b/new-luxc/source/luxc/module/descriptor/annotation.lux
index d5e0d8000..ed5419974 100644
--- a/new-luxc/source/luxc/module/descriptor/annotation.lux
+++ b/new-luxc/source/luxc/module/descriptor/annotation.lux
@@ -5,7 +5,6 @@
(data [text]
(text format
["l" lexer "l/" Monad<Lexer>])
- [char]
[number]
error
(coll [list "L/" Functor<List>])))
@@ -23,7 +22,6 @@
[int-signal "I"]
[deg-signal "D"]
[real-signal "R"]
- [char-signal "C"]
[text-signal "T"]
[list-signal "%"]
[dict-signal "#"]
@@ -54,7 +52,6 @@
[#;IntA int-signal %i]
[#;DegA deg-signal %d]
[#;RealA real-signal %r]
- [#;CharA char-signal %c]
[#;TextA text-signal %t]
[#;IdentA ident-signal %ident]
[#;ListA list-signal (&;encode-list encode-ann-value)]
diff --git a/new-luxc/source/luxc/module/descriptor/common.lux b/new-luxc/source/luxc/module/descriptor/common.lux
index 60a313115..aac438a6f 100644
--- a/new-luxc/source/luxc/module/descriptor/common.lux
+++ b/new-luxc/source/luxc/module/descriptor/common.lux
@@ -3,17 +3,16 @@
(lux (data [text]
(text format
["l" lexer "l/" Monad<Lexer>])
- [char]
(coll [list "L/" Functor<List>]))))
(type: #export Signal Text)
(do-template [<name> <code>]
- [(def: #export <name> Signal (|> <code> char;char char;as-text))]
+ [(def: #export <name> Signal <code>)]
- [cons-signal +5]
- [nil-signal +6]
- [stop-signal +7]
+ [cons-signal "\u0005"]
+ [nil-signal "\u0006"]
+ [stop-signal "\u0007"]
)
(do-template [<name> <code>]
diff --git a/new-luxc/source/luxc/module/descriptor/type.lux b/new-luxc/source/luxc/module/descriptor/type.lux
index dd11a163f..bcf44e5a2 100644
--- a/new-luxc/source/luxc/module/descriptor/type.lux
+++ b/new-luxc/source/luxc/module/descriptor/type.lux
@@ -5,7 +5,6 @@
(data [text]
(text format
["l" lexer "l/" Monad<Lexer>])
- [char]
[number]
["R" result]
(coll [list "L/" Functor<List>]))
diff --git a/new-luxc/source/luxc/parser.lux b/new-luxc/source/luxc/parser.lux
index 1e280e62b..7d9c77f2b 100644
--- a/new-luxc/source/luxc/parser.lux
+++ b/new-luxc/source/luxc/parser.lux
@@ -30,7 +30,6 @@
(lux (control monad
["p" parser "p/" Monad<Parser>])
(data [bool]
- [char]
[text]
["R" result]
[number]
@@ -160,29 +159,28 @@
## and 4 characters long (e.g. \u12aB).
## Escaped characters may show up in Char and Text literals.
(def: escaped-char^
- (l;Lexer [Text Char])
+ (l;Lexer [Nat Text])
(p;after (l;this "\\")
(do p;Monad<Parser>
[code l;any]
(case code
## Handle special cases.
- "t" (wrap ["\\t" #"\t"])
- "v" (wrap ["\\v" #"\v"])
- "b" (wrap ["\\b" #"\b"])
- "n" (wrap ["\\n" #"\n"])
- "r" (wrap ["\\r" #"\r"])
- "f" (wrap ["\\f" #"\f"])
- "\"" (wrap ["\\\"" #"\""])
- "\\" (wrap ["\\\\" #"\\"])
+ "t" (wrap [+2 "\t"])
+ "v" (wrap [+2 "\v"])
+ "b" (wrap [+2 "\b"])
+ "n" (wrap [+2 "\n"])
+ "r" (wrap [+2 "\r"])
+ "f" (wrap [+2 "\f"])
+ "\"" (wrap [+2 "\""])
+ "\\" (wrap [+2 "\\"])
## Handle unicode escapes.
"u"
(do p;Monad<Parser>
- [code (l;between +1 +4 l;hex-digit)]
- (wrap (case (:: number;Hex@Codec<Text,Nat> decode
- (format "+" code))
+ [code (l;between +1 +4 l;hexadecimal)]
+ (wrap (case (|> code (format "+") (:: number;Hex@Codec<Text,Nat> decode))
(#;Right value)
- [(format "\\u" code) (char;char value)]
+ [(n.+ +2 (text;size code)) (text;from-code value)]
_
(undefined))))
@@ -190,31 +188,17 @@
_
(p;fail (format "Invalid escaping syntax: " (%t code)))))))
-## A character can be either a normal glyph, or a escaped character.
-## The reason why this parser returns both the Char and it's textual
-## representation in the source-code, is for the sake of updating the
-## cursor after parsing the char.
-## A character only represents one glyph, but it's source-code
-## representation may be multi-glyph (e.g. \u1234, \n), in which case,
-## the text that was parsed needs to be counted to update the cursor.
-(def: raw-char^
- (l;Lexer [Text Char])
- (p;either (do p;Monad<Parser>
- [char (l;none-of "\\\"\n")]
- (wrap [char (|> char (text;nth +0) assume)]))
- escaped-char^))
-
## These are very simple parsers that just cut chunks of text in
## specific shapes and then use decoders already present in the
## standard library to actually produce the values from the literals.
(def: rich-digit
(l;Lexer Text)
- (p;either l;digit
+ (p;either l;decimal
(p;after (l;this "_") (p/wrap ""))))
(def: rich-digits^
(l;Lexer Text)
- (l;seq l;digit
+ (l;seq l;decimal
(l;some rich-digit)))
(def: (marker^ token)
@@ -262,16 +246,6 @@
number;Codec<Text,Deg>]
)
-## This parser doesn't delegate the work of producing the value to a
-## codec, since the raw-char^ parser already takes care of that magic.
-(def: #export (parse-char where)
- (-> Cursor (l;Lexer [Cursor Code]))
- (do p;Monad<Parser>
- [[chunk value] (l;enclosed ["#\"" "\""]
- raw-char^)]
- (wrap [(update@ #;column (|>. ($_ n.+ +3 (text;size chunk))) where)
- [where (#;Char value)]])))
-
## This parser looks so complex because text in Lux can be multi-line
## and there are rules regarding how this is handled.
(def: #export (parse-text where)
@@ -334,10 +308,10 @@
## Must handle escaped
## chars separately.
(do @
- [[chunk char] escaped-char^]
- (recur (format text-read (char;as-text char))
+ [[chars-consumed char] escaped-char^]
+ (recur (format text-read char)
(|> where
- (update@ #;column (n.+ (text;size chunk))))
+ (update@ #;column (n.+ chars-consumed)))
false))
## The text ends when it
## reaches the right-delimiter.
@@ -538,15 +512,14 @@
(parse-deg where)
(parse-symbol where)
(parse-tag where)
- (parse-char where)
(parse-text where)
)))
(def: #export (parse [where code])
(-> [Cursor Text] (R;Result [[Cursor Text] Code]))
- (case (p;run code (parse-ast where))
+ (case (p;run [+0 code] (parse-ast where))
(#R;Error error)
(#R;Error error)
- (#R;Success [remaining [where' output]])
+ (#R;Success [[_ remaining] [where' output]])
(#R;Success [[where' remaining] output])))
diff --git a/new-luxc/source/luxc/synthesizer.lux b/new-luxc/source/luxc/synthesizer.lux
index 2f7344c6e..484864652 100644
--- a/new-luxc/source/luxc/synthesizer.lux
+++ b/new-luxc/source/luxc/synthesizer.lux
@@ -2,12 +2,14 @@
lux
(lux (data text/format
[number]
+ [product]
(coll [list "L/" Functor<List> Fold<List> Monoid<List>]
["d" dict])))
(luxc ["&" base]
(lang ["la" analysis]
["ls" synthesis])
(synthesizer ["&&;" structure]
+ ["&&;" case]
["&&;" function]
["&&;" loop])
))
@@ -37,7 +39,6 @@
[#la;Int #ls;Int]
[#la;Deg #ls;Deg]
[#la;Real #ls;Real]
- [#la;Char #ls;Char]
[#la;Text #ls;Text]
[#la;Absolute #ls;Definition])
@@ -63,6 +64,38 @@
(#ls;Variable (let [var (&&function;to-captured register)]
(default var (d;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;Relative (#;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
+ (L/fold &&case;weave
+ (transform-branch lastP lastA)
+ (L/map (product;uncurry transform-branch) prevsPA))))
+
+ _
+ (undefined)
+ ))
+
(#la;Function scope bodyA)
(let [inner-arity (n.inc outer-arity)
raw-env (&&function;environment scope)
@@ -111,36 +144,4 @@
(#la;Procedure name args)
(#ls;Procedure name (L/map (recur +0 resolver num-locals) args))
-
- _
- (undefined)
-
- ## (#la;Case inputA branchesA)
- ## (let [inputS (recur +0 local-offset false inputA)]
- ## (case branchesA
- ## (^multi (^ (list [(#lp;Bind input-register)
- ## (#la;Variable (#;Local output-register))]))
- ## (n.= input-register output-register))
- ## inputS
-
- ## (^ (list [(#lp;Bind register) 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 +0 local-offset tail? thenA)
- ## (recur +0 local-offset tail? elseA))
-
- ## (#;Cons [headP headA] tailPA)
- ## (let [headP+ (|> (recur +0 local-offset tail? headA)
- ## #ls;ExecP
- ## (#ls;SeqP (&&case;path headP)))
- ## tailP+ (L/map (function [[pattern bodyA]]
- ## (|> (recur +0 local-offset tail? bodyA)
- ## #ls;ExecP
- ## (#ls;SeqP (&&case;path pattern))))
- ## tailPA)]
- ## (#ls;Case inputS (&&case;weave-paths headP+ tailP+)))
- ## ))
)))
diff --git a/new-luxc/source/luxc/synthesizer/case.lux b/new-luxc/source/luxc/synthesizer/case.lux
new file mode 100644
index 000000000..ee2ef84b0
--- /dev/null
+++ b/new-luxc/source/luxc/synthesizer/case.lux
@@ -0,0 +1,91 @@
+(;module:
+ lux
+ (lux (data [bool "B/" Eq<Bool>]
+ [text "T/" Eq<Text>]
+ [number]
+ (coll [list "L/" Functor<List> Fold<List> Monoid<List>]
+ ["s" set])))
+ (luxc (lang ["la" analysis]
+ ["ls" synthesis])
+ (synthesizer ["&;" function])))
+
+(def: #export (path pattern)
+ (-> la;Pattern ls;Path)
+ (case pattern
+ (^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;RealP #ls;RealP]
+ [#la;TextP #ls;TextP])
+
+ (#la;TupleP membersP)
+ (case (list;reverse membersP)
+ #;Nil
+ #ls;UnitP
+
+ (#;Cons singletonP #;Nil)
+ (path singletonP)
+
+ (#;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))
+
+ (#la;VariantP tag num-tags memberP)
+ (let [last? (n.= (n.dec num-tags) tag)]
+ (#ls;VariantP (if last? (#;Right tag) (#;Left tag))
+ (path memberP)))))
+
+(def: #export (weave nextP prevP)
+ (-> ls;Path ls;Path ls;Path)
+ (with-expansions [<default> (as-is (#ls;AltP prevP nextP))]
+ (case [nextP prevP]
+ [#ls;UnitP #ls;UnitP]
+ #ls;UnitP
+
+ (^template [<tag> <test>]
+ [(<tag> next) (<tag> prev)]
+ (if (<test> next prev)
+ prevP
+ <default>))
+ ([#ls;BindP n.=]
+ [#ls;BoolP B/=]
+ [#ls;NatP n.=]
+ [#ls;IntP i.=]
+ [#ls;DegP d.=]
+ [#ls;RealP r.=]
+ [#ls;TextP T/=])
+
+ (^template [<tag> <side>]
+ [(<tag> (<side> next-idx) next-then) (<tag> (<side> prev-idx) prev-then)]
+ (if (n.= next-idx prev-idx)
+ (weave next-then prev-then)
+ <default>))
+ ([#ls;TupleP #;Left]
+ [#ls;TupleP #;Right]
+ [#ls;VariantP #;Left]
+ [#ls;VariantP #;Right])
+
+ [(#ls;SeqP next-pre next-post) (#ls;SeqP prev-pre prev-post)]
+ (case (weave next-pre prev-pre)
+ (#ls;AltP _ _)
+ <default>
+
+ weavedP
+ (#ls;SeqP weavedP (weave next-post prev-post)))
+
+ _
+ <default>)))
diff --git a/new-luxc/source/luxc/synthesizer/function.lux b/new-luxc/source/luxc/synthesizer/function.lux
index 42aa7a6cd..e8b2a7ec4 100644
--- a/new-luxc/source/luxc/synthesizer/function.lux
+++ b/new-luxc/source/luxc/synthesizer/function.lux
@@ -44,6 +44,10 @@
(-> Nat Int)
(|> idx n.inc nat-to-int (i.* -1)))
+(def: #export (captured-idx idx)
+ (-> Int Nat)
+ (|> idx (i.* -1) int-to-nat n.dec))
+
(def: #export (to-local idx)
(-> Nat Int)
(nat-to-int idx))
diff --git a/new-luxc/source/luxc/synthesizer/variable.lux b/new-luxc/source/luxc/synthesizer/variable.lux
new file mode 100644
index 000000000..3a48cb3f2
--- /dev/null
+++ b/new-luxc/source/luxc/synthesizer/variable.lux
@@ -0,0 +1,100 @@
+(;module:
+ lux
+ (lux (data [bool "B/" Eq<Bool>]
+ [text "T/" Eq<Text>]
+ [number]
+ (coll [list "L/" Functor<List> Fold<List> Monoid<List>]
+ ["s" set])))
+ (luxc (lang ["la" analysis]
+ ["ls" synthesis])
+ (synthesizer ["&;" function])))
+
+(def: (bound-vars path)
+ (-> ls;Path (List ls;Variable))
+ (case path
+ (#ls;BindP register)
+ (list (nat-to-int register))
+
+ (^or (#ls;SeqP pre post) (#ls;AltP pre post))
+ (L/append (bound-vars pre) (bound-vars post))
+
+ _
+ (list)))
+
+(def: (path-bodies path)
+ (-> ls;Path (List ls;Synthesis))
+ (case path
+ (#ls;ExecP body)
+ (list body)
+
+ (#ls;SeqP pre post)
+ (path-bodies post)
+
+ (#ls;AltP pre post)
+ (L/append (path-bodies pre) (path-bodies post))
+
+ _
+ (list)))
+
+(def: (non-arg? arity var)
+ (-> ls;Arity ls;Variable Bool)
+ (and (&function;local? var)
+ (n.> arity (int-to-nat var))))
+
+(type: Tracker (s;Set ls;Variable))
+
+(def: init-tracker Tracker (s;new number;Hash<Int>))
+
+(def: (unused-vars current-arity bound exprS)
+ (-> ls;Arity (List ls;Variable) ls;Synthesis (List ls;Variable))
+ (let [tracker (loop [exprS exprS
+ tracker (L/fold s;add init-tracker bound)]
+ (case exprS
+ (#ls;Variable var)
+ (if (non-arg? current-arity var)
+ (s;remove var tracker)
+ tracker)
+
+ (#ls;Variant tag last? memberS)
+ (recur memberS tracker)
+
+ (#ls;Tuple membersS)
+ (L/fold recur tracker membersS)
+
+ (#ls;Call funcS argsS)
+ (L/fold recur (recur funcS tracker) argsS)
+
+ (^or (#ls;Recur argsS)
+ (#ls;Procedure name argsS))
+ (L/fold recur tracker argsS)
+
+ (#ls;Let offset inputS outputS)
+ (|> tracker (recur inputS) (recur outputS))
+
+ (#ls;If testS thenS elseS)
+ (|> tracker (recur testS) (recur thenS) (recur elseS))
+
+ (#ls;Loop offset initsS bodyS)
+ (recur bodyS (L/fold recur tracker initsS))
+
+ (#ls;Case inputS outputPS)
+ (let [tracker' (L/fold s;add
+ (recur inputS tracker)
+ (bound-vars outputPS))]
+ (L/fold recur tracker' (path-bodies outputPS)))
+
+ (#ls;Function arity env bodyS)
+ (L/fold s;remove tracker env)
+
+ _
+ tracker
+ ))]
+ (s;to-list tracker)))
+
+## (def: (optimize-register-use current-arity [pathS bodyS])
+## (-> ls;Arity [ls;Path ls;Synthesis] [ls;Path ls;Synthesis])
+## (let [bound (bound-vars pathS)
+## unused (unused-vars current-arity bound bodyS)
+## adjusted (adjust-vars unused bound)]
+## [(|> pathS (clean-pattern adjusted) simplify-pattern)
+## (clean-expression adjusted bodyS)]))