diff options
Diffstat (limited to '')
29 files changed, 564 insertions, 151 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)])) diff --git a/new-luxc/test/test/luxc/analyser/case.lux b/new-luxc/test/test/luxc/analyser/case.lux index 037f99feb..280c52245 100644 --- a/new-luxc/test/test/luxc/analyser/case.lux +++ b/new-luxc/test/test/luxc/analyser/case.lux @@ -62,7 +62,6 @@ [#;Int r;int code;int] [#;Deg r;deg code;deg] [#;Real r;real code;real] - [#;Char r;char code;char] [#;Text (r;text +5) code;text]) (^ [_ (#;Tuple (list))]) diff --git a/new-luxc/test/test/luxc/analyser/common.lux b/new-luxc/test/test/luxc/analyser/common.lux index 9a17fbb45..683ede10f 100644 --- a/new-luxc/test/test/luxc/analyser/common.lux +++ b/new-luxc/test/test/luxc/analyser/common.lux @@ -25,7 +25,6 @@ [Int code;int r;int] [Deg code;deg r;deg] [Real code;real r;real] - [Char code;char r;char] [Text code;text (r;text +5)] )] ($_ r;either diff --git a/new-luxc/test/test/luxc/analyser/primitive.lux b/new-luxc/test/test/luxc/analyser/primitive.lux index 545b4e0fd..f291e2c7f 100644 --- a/new-luxc/test/test/luxc/analyser/primitive.lux +++ b/new-luxc/test/test/luxc/analyser/primitive.lux @@ -4,7 +4,6 @@ (control monad pipe) (data [bool "B/" Eq<Bool>] - [char "C/" Eq<Char>] [text "T/" Eq<Text>] (text format ["l" lexer]) @@ -33,7 +32,6 @@ %int% r;int %deg% r;deg %real% r;real - %char% r;char %text% (r;text +5)] (with-expansions [<tests> (do-template [<desc> <type> <tag> <value> <analyser>] @@ -55,7 +53,6 @@ ["int" Int #~;Int %int% @;analyse-int] ["deg" Deg #~;Deg %deg% @;analyse-deg] ["real" Real #~;Real %real% @;analyse-real] - ["char" Char #~;Char %char% @;analyse-char] ["text" Text #~;Text %text% @;analyse-text] )] ($_ seq diff --git a/new-luxc/test/test/luxc/generator/primitive.lux b/new-luxc/test/test/luxc/generator/primitive.lux index b1ea17f95..134ff312d 100644 --- a/new-luxc/test/test/luxc/generator/primitive.lux +++ b/new-luxc/test/test/luxc/generator/primitive.lux @@ -6,7 +6,6 @@ (data text/format ["R" result] [bool "B/" Eq<Bool>] - [char "C/" Eq<Char>] [text "T/" Eq<Text>]) ["r" math/random "R/" Monad<Random>] [macro] @@ -26,7 +25,6 @@ %int% r;int %deg% r;deg %real% r;real - %char% r;char %text% (r;text +5)] (with-expansions [<tests> (do-template [<desc> <type> <synthesis> <sample> <test>] @@ -44,7 +42,6 @@ ["int" Int #ls;Int %int% i.=] ["deg" Deg #ls;Deg %deg% d.=] ["real" Real #ls;Real %real% r.=] - ["char" Char #ls;Char %char% C/=] ["text" Text #ls;Text %text% T/=])] ($_ seq (test "Can generate unit." diff --git a/new-luxc/test/test/luxc/generator/structure.lux b/new-luxc/test/test/luxc/generator/structure.lux index 1fcba59d4..51c6c80c7 100644 --- a/new-luxc/test/test/luxc/generator/structure.lux +++ b/new-luxc/test/test/luxc/generator/structure.lux @@ -6,7 +6,6 @@ (data text/format ["R" result] [bool "B/" Eq<Bool>] - [char "C/" Eq<Char>] [text "T/" Eq<Text>] (coll ["a" array] [list])) @@ -33,8 +32,7 @@ (r/map (|>. #ls;Int) r;int))) (r;either (r;either (r/map (|>. #ls;Deg) r;deg) (r/map (|>. #ls;Real) r;real)) - (r;either (r/map (|>. #ls;Char) r;char) - (r/map (|>. #ls;Text) (r;text +5)))))) + (r/map (|>. #ls;Text) (r;text +5))))) (def: (corresponds? [prediction sample]) (-> [ls;Synthesis Top] Bool) @@ -55,7 +53,6 @@ [#ls;Int Int i.=] [#ls;Deg Deg d.=] [#ls;Real Real r.=] - [#ls;Char Char C/=] [#ls;Text Text T/=]) _ diff --git a/new-luxc/test/test/luxc/parser.lux b/new-luxc/test/test/luxc/parser.lux index 21d34f7c0..b7eaa0ea5 100644 --- a/new-luxc/test/test/luxc/parser.lux +++ b/new-luxc/test/test/luxc/parser.lux @@ -2,8 +2,7 @@ lux (lux [io] (control monad) - (data [char "C/" Eq<Char>] - [text "T/" Eq<Text>] + (data [text "T/" Eq<Text>] (text format ["l" lexer]) [number] @@ -27,9 +26,9 @@ delimiters "()[]{}#;" space "\t\v \n\r\f" invalid-range (format digits delimiters space) - char-gen (|> r;char + char-gen (|> r;nat (r;filter (function [sample] - (not (text;contains? (char;as-text sample) + (not (text;contains? (text;from-code sample) invalid-range)))))] size (|> r;nat (:: @ map (|>. (n.% +20) (n.max +1))))] (r;text' char-gen size))) @@ -49,7 +48,6 @@ (|> r;real (r/map (|>. #;Real [default-cursor]))))) textual^ (: (r;Random Code) ($_ r;either - (|> r;char (r/map (|>. #;Char [default-cursor]))) (do r;Monad<Random> [size (|> r;nat (r/map (n.% +20)))] (|> (r;text size) (r/map (|>. #;Text [default-cursor])))) @@ -89,12 +87,11 @@ (def: comment-text^ (r;Random Text) - (let [char-gen (|> r;char (r;filter (function [value] - (not (or (char;space? value) - (C/= #"\n" value) - (C/= #"#" value) - (C/= #"(" value) - (C/= #")" value))))))] + (let [char-gen (|> r;nat (r;filter (function [value] + (not (or (text;space? value) + (n.= (char "#") value) + (n.= (char "(") value) + (n.= (char ")") value))))))] (do r;Monad<Random> [size (|> r;nat (r/map (n.% +20)))] (r;text' char-gen size)))) @@ -112,10 +109,9 @@ (context: "Multi-line text & comments." #seed +13835085537605735783 - [#let [char-gen (|> r;char (r;filter (function [value] - (not (or (char;space? value) - (C/= #"\"" value) - (C/= #"\n" value))))))] + [#let [char-gen (|> r;nat (r;filter (function [value] + (not (or (text;space? value) + (n.= (char "\"") value))))))] x char-gen y char-gen z char-gen @@ -126,9 +122,9 @@ unbalanced-comment comment-text^] ($_ seq (test "Will reject invalid multi-line text." - (let [bad-match (format (char;as-text x) "\n" - (char;as-text y) "\n" - (char;as-text z))] + (let [bad-match (format (text;from-code x) "\n" + (text;from-code y) "\n" + (text;from-code z))] (case (&;parse [default-cursor (format "\"" bad-match "\"")]) (#R;Error error) @@ -137,12 +133,12 @@ (#R;Success [_ parsed]) false))) (test "Will accept valid multi-line text" - (let [good-input (format (char;as-text x) "\n" - offset (char;as-text y) "\n" - offset (char;as-text z)) - good-output (format (char;as-text x) "\n" - (char;as-text y) "\n" - (char;as-text z))] + (let [good-input (format (text;from-code x) "\n" + offset (text;from-code y) "\n" + offset (text;from-code z)) + good-output (format (text;from-code x) "\n" + (text;from-code y) "\n" + (text;from-code z))] (case (&;parse [(|> default-cursor (update@ #;column (n.+ (n.dec offset-size)))) (format "\"" good-input "\"")]) diff --git a/new-luxc/test/test/luxc/synthesizer/case.lux b/new-luxc/test/test/luxc/synthesizer/case.lux new file mode 100644 index 000000000..5e1cf2a32 --- /dev/null +++ b/new-luxc/test/test/luxc/synthesizer/case.lux @@ -0,0 +1,213 @@ +(;module: + lux + (lux [io] + (control monad + pipe + eq) + (data [bool "B/" Eq<Bool>] + [text "T/" Eq<Text>] + [product] + [number] + text/format + (coll [list "L/" Functor<List> Fold<List> Monoid<List>] + ["s" set])) + ["r" math/random "r/" Monad<Random>] + test) + (luxc (lang ["la" analysis] + ["ls" synthesis]) + [synthesizer] + (synthesizer ["@" case])) + (.. common)) + +(struct: _ (Eq ls;Synthesis) + (def: (= reference sample) + (case [reference sample] + (^template [<tag> <test>] + [(<tag> reference') (<tag> sample')] + (<test> reference' sample')) + ([#ls;Unit is] + [#ls;Bool B/=] + [#ls;Nat n.=] + [#ls;Int i.=] + [#ls;Deg d.=] + [#ls;Real r.=] + [#ls;Text T/=]) + + _ + false))) + +(struct: _ (Eq ls;Path) + (def: (= reference sample) + (case [reference sample] + (^or [#ls;UnitP #ls;UnitP] + [(#ls;ExecP _) (#ls;ExecP _)]) + true + + (^template [<tag> <eq>] + [(<tag> reference') (<tag> sample')] + (<eq> reference' sample')) + ([#ls;BindP n.=] + [#ls;BoolP B/=] + [#ls;NatP n.=] + [#ls;IntP i.=] + [#ls;DegP d.=] + [#ls;RealP r.=] + [#ls;TextP T/=]) + + (^template [<outer> <inner>] + [(<outer> (<inner> reference') reference-then) + (<outer> (<inner> sample') sample-then)] + (and (n.= reference' sample') + (= reference-then sample-then))) + ([#ls;VariantP #;Left] + [#ls;VariantP #;Right] + [#ls;TupleP #;Left] + [#ls;TupleP #;Right]) + + (^template [<tag>] + [(<tag> referenceL referenceR) (<tag> sampleL sampleR)] + (and (= referenceL sampleL) + (= referenceR sampleR))) + ([#ls;AltP] + [#ls;SeqP]) + + _ + false))) + +(do-template [<name> <path> <sampler> <hash> <max>] + [(def: <name> + (r;Random ls;Path) + (do r;Monad<Random> + [num-alts (|> r;nat (:: @ map (|>. (n.% <max>) (n.max +1)))) + samples (|> (r;set <hash> num-alts <sampler>) + (:: @ map s;to-list))] + (case (|> samples + (L/map (|>. <path>)) + list;reverse) + (#;Cons last prevs) + (wrap (L/fold (function [left right] + (#ls;AltP left right)) + last + prevs)) + + #;Nil + (undefined))))] + + [gen-bool #ls;BoolP r;bool bool;Hash<Bool> +2] + [gen-nat #ls;NatP r;nat number;Hash<Nat> +5] + [gen-int #ls;IntP r;int number;Hash<Int> +5] + [gen-deg #ls;DegP r;deg number;Hash<Deg> +5] + [gen-real #ls;RealP r;real number;Hash<Real> +5] + [gen-text #ls;TextP (r;text +5) text;Hash<Text> +5] + ) + +(def: gen-primitive-path + (r;Random ls;Path) + (r;either (r;either (r;either (r/wrap #ls;UnitP) + gen-bool) + (r;either gen-nat + gen-int)) + (r;either (r;either gen-deg + gen-real) + gen-text))) + +(do-template [<name> <tag> <join>] + [(def: (<name> gen-path) + (-> (-> (Maybe ls;Synthesis) (r;Random ls;Path)) + (r;Random ls;Path)) + (do r;Monad<Random> + [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) + members (r;list size (gen-path #;None))] + (case (list;reverse (list;enumerate members)) + (#;Cons [last-idx last-path] prevs) + (wrap (L/fold (function [[left-idx left-path] right-path] + (<join> (<tag> (#;Right left-idx) left-path) + right-path)) + (<tag> (#;Right last-idx) last-path) + prevs)) + + #;Nil + (undefined))))] + + [gen-tuple-path #ls;TupleP #ls;SeqP] + [gen-variant-path #ls;VariantP #ls;AltP] + ) + +(def: (gen-path ?body) + (-> (Maybe ls;Synthesis) (r;Random ls;Path)) + (do r;Monad<Random> + [pattern (r;either (r;either (r/wrap (#ls;BindP +0)) + gen-primitive-path) + (r;either (gen-tuple-path gen-path) + (gen-variant-path gen-path)))] + (case ?body + #;None + (wrap pattern) + + (#;Some body) + (wrap (#ls;SeqP pattern (#ls;ExecP body)))))) + +(def: (to-branches path) + (-> ls;Path (List la;Pattern)) + (case path + (^template [<from> <to>] + (<from> value) + (list (<to> value))) + ([#ls;UnitP #la;UnitP] + [#ls;BoolP #la;BoolP] + [#ls;NatP #la;NatP] + [#ls;IntP #la;IntP] + [#ls;DegP #la;DegP] + [#ls;RealP #la;RealP] + [#ls;TextP #la;TextP] + [#ls;BindP #la;BindP]) + + (#ls;AltP left right) + (L/append (to-branches left) + (to-branches right)) + + (#ls;SeqP (#ls;TupleP (#;Left +0) head) + tail) + (loop [head head + tail tail] + (case [(path-to-pattern head) tail] + [(#;Some =head) (#ls;SeqP (#ls;TupleP (#;Left idx) head') + tail')] + (list& =head (recur head' tail')) + + [(#;Some =head) (#ls;SeqP (#ls;TupleP (#;Left idx) head') + tail')] + (list& =head (recur head' tail')) + + [(#;Some =head) (#ls;SeqP (#ls;TupleP (#;Right last-idx)) + tail')] + (do list;Monad<List> + [=tail' (to-branches tail') + =right (to-branches right)] + ))) + + (#ls;SeqP left right) + (do list;Monad<List> + [=left (to-branches left) + =right (to-branches right)] + ) + + #PopP + (#VariantP (Either Nat Nat)) + (#TupleP (Either Nat Nat)) + + + (#ExecP s) + )) + +(context: "Pattern-matching." + [outputA gen-primitive + prediction (gen-path (#;Some (synthesizer;synthesize outputA))) + #let [branches (to-branches outputA prediction)]] + (test "Can efficiently synthesize pattern-matching trees." + (|> (synthesizer;synthesize (#la;Case #la;Unit branches)) + (case> (#la;Case #ls;Unit pathS) + (:: Eq<Path> prediction pathS) + + _ + false)))) diff --git a/new-luxc/test/test/luxc/synthesizer/case/special.lux b/new-luxc/test/test/luxc/synthesizer/case/special.lux new file mode 100644 index 000000000..fe5ad20ac --- /dev/null +++ b/new-luxc/test/test/luxc/synthesizer/case/special.lux @@ -0,0 +1,66 @@ +(;module: + lux + (lux [io] + (control monad + pipe) + (data [product] + [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]) + [synthesizer]) + (../.. common)) + +(context: "Dummy variables." + [maskedA gen-primitive + temp r;nat + #let [maskA (#la;Case maskedA + (list [(#la;BindP temp) + (#la;Relative (#;Local temp))]))]] + (test "Dummy variables created to mask expressions get eliminated during synthesis." + (|> (synthesizer;synthesize maskA) + (corresponds? maskedA)))) + +(context: "Let expressions." + [registerA r;nat + inputA gen-primitive + outputA gen-primitive + #let [letA (#la;Case inputA + (list [(#la;BindP registerA) + outputA]))]] + (test "Can detect and reify simple 'let' expressions." + (|> (synthesizer;synthesize letA) + (case> (#ls;Let registerS inputS outputS) + (and (n.= registerA registerS) + (corresponds? inputA inputS) + (corresponds? outputA outputS)) + + _ + false)))) + +(context: "If expressions." + [then|else r;bool + inputA gen-primitive + thenA gen-primitive + elseA gen-primitive + #let [ifA (if then|else + (#la;Case inputA + (list [(#la;BoolP true) thenA] + [(#la;BoolP false) elseA])) + (#la;Case inputA + (list [(#la;BoolP false) elseA] + [(#la;BoolP true) thenA])))]] + (test "Can detect and reify simple 'if' expressions." + (|> (synthesizer;synthesize ifA) + (case> (#ls;If inputS thenS elseS) + (and (corresponds? inputA inputS) + (corresponds? thenA thenS) + (corresponds? elseA elseS)) + + _ + false)))) diff --git a/new-luxc/test/test/luxc/synthesizer/common.lux b/new-luxc/test/test/luxc/synthesizer/common.lux index c02e23c7c..88eeaea7c 100644 --- a/new-luxc/test/test/luxc/synthesizer/common.lux +++ b/new-luxc/test/test/luxc/synthesizer/common.lux @@ -1,7 +1,6 @@ (;module: lux (lux (data [bool "B/" Eq<Bool>] - [char "C/" Eq<Char>] [text "T/" Eq<Text>]) ["r" math/random "r/" Monad<Random>]) (luxc (lang ["la" analysis] @@ -15,8 +14,7 @@ (r/map (|>. #la;Int) r;int))) (r;either (r;either (r/map (|>. #la;Deg) r;deg) (r/map (|>. #la;Real) r;real)) - (r;either (r/map (|>. #la;Char) r;char) - (r/map (|>. #la;Text) (r;text +5)))))) + (r/map (|>. #la;Text) (r;text +5))))) (def: #export (corresponds? analysis synthesis) (-> la;Analysis ls;Synthesis Bool) @@ -30,7 +28,6 @@ [#la;Int #ls;Int i.=] [#la;Deg #ls;Deg d.=] [#la;Real #ls;Real r.=] - [#la;Char #ls;Char C/=] [#la;Text #ls;Text T/=]) _ diff --git a/new-luxc/test/test/luxc/synthesizer/primitive.lux b/new-luxc/test/test/luxc/synthesizer/primitive.lux index c17d41a78..e1e37e469 100644 --- a/new-luxc/test/test/luxc/synthesizer/primitive.lux +++ b/new-luxc/test/test/luxc/synthesizer/primitive.lux @@ -17,7 +17,6 @@ %int% r;int %deg% r;deg %real% r;real - %char% r;char %text% (r;text +5)] (with-expansions [<tests> (do-template [<desc> <analysis> <synthesis> <sample>] @@ -35,7 +34,6 @@ ["int" #la;Int #ls;Int %int%] ["deg" #la;Deg #ls;Deg %deg%] ["real" #la;Real #ls;Real %real%] - ["char" #la;Char #ls;Char %char%] ["text" #la;Text #ls;Text %text%])] ($_ seq <tests>))) |