diff options
| author | Eduardo Julian | 2017-12-01 18:13:05 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2017-12-01 18:13:05 -0400 |
| commit | 84a71e373e01f36c57d1bf42b7946f3a8b212d4f (patch) | |
| tree | 6aacee5d18fca8277c2c532b9e48aa8b3779d8e4 | |
| parent | 4433c9bcd6c6cac44c018aad2e21a5b4d7cc4896 (diff) | |
- Got the tests to compile again.
25 files changed, 1636 insertions, 1636 deletions
diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux index 1215e669f..914e31893 100644 --- a/new-luxc/test/test/luxc/common.lux +++ b/new-luxc/test/test/luxc/common.lux @@ -1,9 +1,9 @@ -(;module: +(.module: lux (lux [io]) - (luxc (lang ["&;" host] - [";L" translation]))) + (luxc (lang ["&." host] + [".L" translation]))) (def: #export (init-compiler _) (-> Top Compiler) - (translationL;init-compiler (io;run &host;init-host))) + (translationL.init-compiler (io.run &host.init-host))) diff --git a/new-luxc/test/test/luxc/lang/analysis/case.lux b/new-luxc/test/test/luxc/lang/analysis/case.lux index f99c034e8..50d31a86e 100644 --- a/new-luxc/test/test/luxc/lang/analysis/case.lux +++ b/new-luxc/test/test/luxc/lang/analysis/case.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -18,80 +18,80 @@ (type ["tc" check])) test) (luxc ["&" lang] - (lang ["@;" module] + (lang ["@." module] ["la" analysis] - (analysis [";A" expression] + (analysis [".A" expression] ["@" case] - ["@;" common]))) - (.. common) + ["@." common]))) + (// common) (test/luxc common)) (def: (exhaustive-weaving branchings) (-> (List (List Code)) (List (List Code))) (case branchings - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons head+ #;Nil) - (L/map (|>. list) head+) + (#.Cons head+ #.Nil) + (L/map (|>> list) head+) - (#;Cons head+ tail++) - (do list;Monad<List> + (#.Cons head+ tail++) + (do list.Monad<List> [tail+ (exhaustive-weaving tail++) head head+] - (wrap (#;Cons head tail+))))) + (wrap (#.Cons head tail+))))) (def: #export (exhaustive-branches allow-literals? variantTC inputC) - (-> Bool (List [Code Code]) Code (r;Random (List Code))) + (-> Bool (List [Code Code]) Code (r.Random (List Code))) (case inputC - [_ (#;Bool _)] + [_ (#.Bool _)] (r/wrap (list (' true) (' false))) (^template [<tag> <gen> <wrapper>] [_ (<tag> _)] (if allow-literals? - (do r;Monad<Random> - [?sample (r;maybe <gen>)] + (do r.Monad<Random> + [?sample (r.maybe <gen>)] (case ?sample - (#;Some sample) + (#.Some sample) (do @ [else (exhaustive-branches allow-literals? variantTC inputC)] (wrap (list& (<wrapper> sample) else))) - #;None + #.None (wrap (list (' _))))) (r/wrap (list (' _))))) - ([#;Nat r;nat code;nat] - [#;Int r;int code;int] - [#;Deg r;deg code;deg] - [#;Frac r;frac code;frac] - [#;Text (r;text +5) code;text]) + ([#.Nat r.nat code.nat] + [#.Int r.int code.int] + [#.Deg r.deg code.deg] + [#.Frac r.frac code.frac] + [#.Text (r.text +5) code.text]) - (^ [_ (#;Tuple (list))]) + (^ [_ (#.Tuple (list))]) (r/wrap (list (' []))) - (^ [_ (#;Record (list))]) + (^ [_ (#.Record (list))]) (r/wrap (list (' {}))) - [_ (#;Tuple members)] - (do r;Monad<Random> - [member-wise-patterns (monad;map @ (exhaustive-branches allow-literals? variantTC) members)] + [_ (#.Tuple members)] + (do r.Monad<Random> + [member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) members)] (wrap (|> member-wise-patterns exhaustive-weaving - (L/map code;tuple)))) + (L/map code.tuple)))) - [_ (#;Record kvs)] - (do r;Monad<Random> - [#let [ks (L/map product;left kvs) - vs (L/map product;right kvs)] - member-wise-patterns (monad;map @ (exhaustive-branches allow-literals? variantTC) vs)] + [_ (#.Record kvs)] + (do r.Monad<Random> + [#let [ks (L/map product.left kvs) + vs (L/map product.right kvs)] + member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) vs)] (wrap (|> member-wise-patterns exhaustive-weaving - (L/map (|>. (list;zip2 ks) code;record))))) + (L/map (|>> (list.zip2 ks) code.record))))) - (^ [_ (#;Form (list [_ (#;Tag _)] _))]) - (do r;Monad<Random> - [bundles (monad;map @ + (^ [_ (#.Form (list [_ (#.Tag _)] _))]) + (do r.Monad<Random> + [bundles (monad.map @ (function [[_tag _code]] (do @ [v-branches (exhaustive-branches allow-literals? variantTC _code)] @@ -105,21 +105,21 @@ )) (def: #export (input variant-tags record-tags primitivesC) - (-> (List Code) (List Code) (List Code) (r;Random Code)) - (r;rec + (-> (List Code) (List Code) (List Code) (r.Random Code)) + (r.rec (function [input] - ($_ r;either - (r/map product;right gen-primitive) - (do r;Monad<Random> - [choice (|> r;nat (:: @ map (n.% (list;size variant-tags)))) - #let [choiceT (maybe;assume (list;nth choice variant-tags)) - choiceC (maybe;assume (list;nth choice primitivesC))]] + ($_ r.either + (r/map product.right gen-primitive) + (do r.Monad<Random> + [choice (|> r.nat (:: @ map (n/% (list.size variant-tags)))) + #let [choiceT (maybe.assume (list.nth choice variant-tags)) + choiceC (maybe.assume (list.nth choice primitivesC))]] (wrap (` ((~ choiceT) (~ choiceC))))) - (do r;Monad<Random> - [size (|> r;nat (:: @ map (n.% +3))) - elems (r;list size input)] - (wrap (code;tuple elems))) - (r/wrap (code;record (list;zip2 record-tags primitivesC))) + (do r.Monad<Random> + [size (|> r.nat (:: @ map (n/% +3))) + elems (r.list size input)] + (wrap (code.tuple elems))) + (r/wrap (code.record (list.zip2 record-tags primitivesC))) )))) (def: (branch body pattern) @@ -132,96 +132,96 @@ (<| (seed +5004137551292836565) ## (times +100) (do @ - [module-name (r;text +5) - variant-name (r;text +5) - record-name (|> (r;text +5) (r;filter (|>. (T/= variant-name) not))) - size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) - variant-tags (|> (r;set text;Hash<Text> size (r;text +5)) (:: @ map S;to-list)) - record-tags (|> (r;set text;Hash<Text> size (r;text +5)) (:: @ map S;to-list)) - primitivesTC (r;list size gen-primitive) - #let [primitivesT (L/map product;left primitivesTC) - primitivesC (L/map product;right primitivesTC) - variant-tags+ (L/map (|>. [module-name] code;tag) variant-tags) - record-tags+ (L/map (|>. [module-name] code;tag) record-tags) - variantTC (list;zip2 variant-tags+ primitivesC)] + [module-name (r.text +5) + variant-name (r.text +5) + record-name (|> (r.text +5) (r.filter (|>> (T/= variant-name) not))) + size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2)))) + variant-tags (|> (r.set text.Hash<Text> size (r.text +5)) (:: @ map S.to-list)) + record-tags (|> (r.set text.Hash<Text> size (r.text +5)) (:: @ map S.to-list)) + primitivesTC (r.list size gen-primitive) + #let [primitivesT (L/map product.left primitivesTC) + primitivesC (L/map product.right primitivesTC) + variant-tags+ (L/map (|>> [module-name] code.tag) variant-tags) + record-tags+ (L/map (|>> [module-name] code.tag) record-tags) + variantTC (list.zip2 variant-tags+ primitivesC)] inputC (input variant-tags+ record-tags+ primitivesC) [outputT outputC] gen-primitive [heterogeneousT heterogeneousC] (|> gen-primitive - (r;filter (|>. product;left (tc;checks? outputT) not))) + (r.filter (|>> product.left (tc.checks? outputT) not))) exhaustive-patterns (exhaustive-branches true variantTC inputC) redundant-patterns (exhaustive-branches false variantTC inputC) - redundancy-idx (|> r;nat (:: @ map (n.% (list;size redundant-patterns)))) - heterogeneous-idx (|> r;nat (:: @ map (n.% (list;size exhaustive-patterns)))) + redundancy-idx (|> r.nat (:: @ map (n/% (list.size redundant-patterns)))) + heterogeneous-idx (|> r.nat (:: @ map (n/% (list.size exhaustive-patterns)))) #let [exhaustive-branchesC (L/map (branch outputC) exhaustive-patterns) - non-exhaustive-branchesC (list;take (n.dec (list;size exhaustive-branchesC)) + non-exhaustive-branchesC (list.take (n/dec (list.size exhaustive-branchesC)) exhaustive-branchesC) redundant-branchesC (<| (L/map (branch outputC)) - list;concat - (list (list;take redundancy-idx redundant-patterns) - (list (maybe;assume (list;nth redundancy-idx redundant-patterns))) - (list;drop redundancy-idx redundant-patterns))) - heterogeneous-branchesC (list;concat (list (list;take heterogeneous-idx exhaustive-branchesC) - (list (let [[_pattern _body] (maybe;assume (list;nth heterogeneous-idx exhaustive-branchesC))] + list.concat + (list (list.take redundancy-idx redundant-patterns) + (list (maybe.assume (list.nth redundancy-idx redundant-patterns))) + (list.drop redundancy-idx redundant-patterns))) + heterogeneous-branchesC (list.concat (list (list.take heterogeneous-idx exhaustive-branchesC) + (list (let [[_pattern _body] (maybe.assume (list.nth heterogeneous-idx exhaustive-branchesC))] [_pattern heterogeneousC])) - (list;drop (n.inc heterogeneous-idx) exhaustive-branchesC))) + (list.drop (n/inc heterogeneous-idx) exhaustive-branchesC))) ]] ($_ seq (test "Will reject empty pattern-matching (no branches)." - (|> (&;with-scope - (&;with-type outputT - (@;analyse-case analyse inputC (list)))) + (|> (&.with-scope + (&.with-type outputT + (@.analyse-case analyse inputC (list)))) check-failure)) (test "Can analyse exhaustive pattern-matching." - (|> (@module;with-module +0 module-name + (|> (@module.with-module +0 module-name (do Monad<Meta> - [_ (@module;declare-tags variant-tags false - (#;Named [module-name variant-name] - (type;variant primitivesT))) - _ (@module;declare-tags record-tags false - (#;Named [module-name record-name] - (type;tuple primitivesT)))] - (&;with-scope - (&;with-type outputT - (@;analyse-case analyse inputC exhaustive-branchesC))))) + [_ (@module.declare-tags variant-tags false + (#.Named [module-name variant-name] + (type.variant primitivesT))) + _ (@module.declare-tags record-tags false + (#.Named [module-name record-name] + (type.tuple primitivesT)))] + (&.with-scope + (&.with-type outputT + (@.analyse-case analyse inputC exhaustive-branchesC))))) check-success)) (test "Will reject non-exhaustive pattern-matching." - (|> (@module;with-module +0 module-name + (|> (@module.with-module +0 module-name (do Monad<Meta> - [_ (@module;declare-tags variant-tags false - (#;Named [module-name variant-name] - (type;variant primitivesT))) - _ (@module;declare-tags record-tags false - (#;Named [module-name record-name] - (type;tuple primitivesT)))] - (&;with-scope - (&;with-type outputT - (@;analyse-case analyse inputC non-exhaustive-branchesC))))) + [_ (@module.declare-tags variant-tags false + (#.Named [module-name variant-name] + (type.variant primitivesT))) + _ (@module.declare-tags record-tags false + (#.Named [module-name record-name] + (type.tuple primitivesT)))] + (&.with-scope + (&.with-type outputT + (@.analyse-case analyse inputC non-exhaustive-branchesC))))) check-failure)) (test "Will reject redundant pattern-matching." - (|> (@module;with-module +0 module-name + (|> (@module.with-module +0 module-name (do Monad<Meta> - [_ (@module;declare-tags variant-tags false - (#;Named [module-name variant-name] - (type;variant primitivesT))) - _ (@module;declare-tags record-tags false - (#;Named [module-name record-name] - (type;tuple primitivesT)))] - (&;with-scope - (&;with-type outputT - (@;analyse-case analyse inputC redundant-branchesC))))) + [_ (@module.declare-tags variant-tags false + (#.Named [module-name variant-name] + (type.variant primitivesT))) + _ (@module.declare-tags record-tags false + (#.Named [module-name record-name] + (type.tuple primitivesT)))] + (&.with-scope + (&.with-type outputT + (@.analyse-case analyse inputC redundant-branchesC))))) check-failure)) (test "Will reject pattern-matching if the bodies of the branches do not all have the same type." - (|> (@module;with-module +0 module-name + (|> (@module.with-module +0 module-name (do Monad<Meta> - [_ (@module;declare-tags variant-tags false - (#;Named [module-name variant-name] - (type;variant primitivesT))) - _ (@module;declare-tags record-tags false - (#;Named [module-name record-name] - (type;tuple primitivesT)))] - (&;with-scope - (&;with-type outputT - (@;analyse-case analyse inputC heterogeneous-branchesC))))) + [_ (@module.declare-tags variant-tags false + (#.Named [module-name variant-name] + (type.variant primitivesT))) + _ (@module.declare-tags record-tags false + (#.Named [module-name record-name] + (type.tuple primitivesT)))] + (&.with-scope + (&.with-type outputT + (@.analyse-case analyse inputC heterogeneous-branchesC))))) check-failure)) )))) diff --git a/new-luxc/test/test/luxc/lang/analysis/common.lux b/new-luxc/test/test/luxc/lang/analysis/common.lux index e7b9dc486..38c712972 100644 --- a/new-luxc/test/test/luxc/lang/analysis/common.lux +++ b/new-luxc/test/test/luxc/lang/analysis/common.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control pipe) ["r" math/random "r/" Monad<Random>] @@ -6,45 +6,45 @@ [macro] (macro [code])) (luxc ["&" lang] - (lang (analysis [";A" expression]) + (lang (analysis [".A" expression]) [eval])) (test/luxc common)) (def: gen-unit - (r;Random Code) + (r.Random Code) (r/wrap (' []))) (def: #export gen-primitive - (r;Random [Type Code]) + (r.Random [Type Code]) (with-expansions [<generators> (do-template [<type> <code-wrapper> <value-gen>] - [(r;seq (r/wrap <type>) (r/map <code-wrapper> <value-gen>))] + [(r.seq (r/wrap <type>) (r/map <code-wrapper> <value-gen>))] - [Unit code;tuple (r;list +0 gen-unit)] - [Bool code;bool r;bool] - [Nat code;nat r;nat] - [Int code;int r;int] - [Deg code;deg r;deg] - [Frac code;frac r;frac] - [Text code;text (r;text +5)] + [Unit code.tuple (r.list +0 gen-unit)] + [Bool code.bool r.bool] + [Nat code.nat r.nat] + [Int code.int r.int] + [Deg code.deg r.deg] + [Frac code.frac r.frac] + [Text code.text (r.text +5)] )] - ($_ r;either + ($_ r.either <generators> ))) (def: #export analyse - &;Analyser - (expressionA;analyser eval;eval)) + &.Analyser + (expressionA.analyser eval.eval)) (do-template [<name> <on-success> <on-failure>] [(def: #export (<name> analysis) (All [a] (-> (Meta a) Bool)) (|> analysis - (macro;run (init-compiler [])) - (case> (#e;Success _) + (macro.run (init-compiler [])) + (case> (#e.Success _) <on-success> - (#e;Error error) + (#e.Error error) <on-failure>)))] [check-success true false] diff --git a/new-luxc/test/test/luxc/lang/analysis/function.lux b/new-luxc/test/test/luxc/lang/analysis/function.lux index b99e5e2ee..3f8a17505 100644 --- a/new-luxc/test/test/luxc/lang/analysis/function.lux +++ b/new-luxc/test/test/luxc/lang/analysis/function.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -15,140 +15,140 @@ (lang [type "type/" Eq<Type>]) test) (luxc ["&" lang] - (lang ["@;" module] + (lang ["@." module] ["la" analysis] - (analysis [";A" expression] + (analysis [".A" expression] ["@" function] - ["@;" common]))) - (.. common) + ["@." common]))) + (// common) (test/luxc common)) (def: (check-type expectedT error) - (-> Type (e;Error [Type la;Analysis]) Bool) + (-> Type (e.Error [Type la.Analysis]) Bool) (case error - (#e;Success [exprT exprA]) + (#e.Success [exprT exprA]) (type/= expectedT exprT) _ false)) (def: (succeeds? error) - (All [a] (-> (e;Error a) Bool)) + (All [a] (-> (e.Error a) Bool)) (case error - (#e;Success _) + (#e.Success _) true - (#e;Error _) + (#e.Error _) false)) (def: (flatten-apply analysis) - (-> la;Analysis [la;Analysis (List la;Analysis)]) + (-> la.Analysis [la.Analysis (List la.Analysis)]) (case analysis (^code ("lux apply" (~ head) (~ func))) (let [[func' tail] (flatten-apply func)] - [func' (#;Cons head tail)]) + [func' (#.Cons head tail)]) _ [analysis (list)])) (def: (check-apply expectedT num-args analysis) - (-> Type Nat (Meta [Type la;Analysis]) Bool) + (-> Type Nat (Meta [Type la.Analysis]) Bool) (|> analysis - (macro;run (init-compiler [])) - (case> (#e;Success [applyT applyA]) + (macro.run (init-compiler [])) + (case> (#e.Success [applyT applyA]) (let [[funcA argsA] (flatten-apply applyA)] (and (type/= expectedT applyT) - (n.= num-args (list;size argsA)))) + (n/= num-args (list.size argsA)))) - (#e;Error error) + (#e.Error error) false))) (context: "Function definition." (<| (times +100) (do @ - [func-name (r;text +5) - arg-name (|> (r;text +5) (r;filter (|>. (text/= func-name) not))) + [func-name (r.text +5) + arg-name (|> (r.text +5) (r.filter (|>> (text/= func-name) not))) [outputT outputC] gen-primitive [inputT _] gen-primitive] ($_ seq (test "Can analyse function." - (|> (&;with-type (type (All [a] (-> a outputT))) - (@;analyse-function analyse func-name arg-name outputC)) - (macro;run (init-compiler [])) + (|> (&.with-type (type (All [a] (-> a outputT))) + (@.analyse-function analyse func-name arg-name outputC)) + (macro.run (init-compiler [])) succeeds?)) (test "Generic functions can always be specialized." - (and (|> (&;with-type (-> inputT outputT) - (@;analyse-function analyse func-name arg-name outputC)) - (macro;run (init-compiler [])) + (and (|> (&.with-type (-> inputT outputT) + (@.analyse-function analyse func-name arg-name outputC)) + (macro.run (init-compiler [])) succeeds?) - (|> (&;with-type (-> inputT inputT) - (@;analyse-function analyse func-name arg-name (code;symbol ["" arg-name]))) - (macro;run (init-compiler [])) + (|> (&.with-type (-> inputT inputT) + (@.analyse-function analyse func-name arg-name (code.symbol ["" arg-name]))) + (macro.run (init-compiler [])) succeeds?))) (test "Can infer function (constant output and unused input)." - (|> (@common;with-unknown-type - (@;analyse-function analyse func-name arg-name outputC)) - (macro;run (init-compiler [])) + (|> (@common.with-unknown-type + (@.analyse-function analyse func-name arg-name outputC)) + (macro.run (init-compiler [])) (check-type (type (All [a] (-> a outputT)))))) (test "Can infer function (output = input)." - (|> (@common;with-unknown-type - (@;analyse-function analyse func-name arg-name (code;symbol ["" arg-name]))) - (macro;run (init-compiler [])) + (|> (@common.with-unknown-type + (@.analyse-function analyse func-name arg-name (code.symbol ["" arg-name]))) + (macro.run (init-compiler [])) (check-type (type (All [a] (-> a a)))))) (test "The function's name is bound to the function's type." - (|> (&;with-type (type (Rec self (-> inputT self))) - (@;analyse-function analyse func-name arg-name (code;symbol ["" func-name]))) - (macro;run (init-compiler [])) + (|> (&.with-type (type (Rec self (-> inputT self))) + (@.analyse-function analyse func-name arg-name (code.symbol ["" func-name]))) + (macro.run (init-compiler [])) succeeds?)) )))) (context: "Function application." (<| (times +100) (do @ - [full-args (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) - partial-args (|> r;nat (:: @ map (n.% full-args))) - var-idx (|> r;nat (:: @ map (|>. (n.% full-args) (n.max +1)))) - inputsTC (r;list full-args gen-primitive) - #let [inputsT (list/map product;left inputsTC) - inputsC (list/map product;right inputsTC)] + [full-args (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2)))) + partial-args (|> r.nat (:: @ map (n/% full-args))) + var-idx (|> r.nat (:: @ map (|>> (n/% full-args) (n/max +1)))) + inputsTC (r.list full-args gen-primitive) + #let [inputsT (list/map product.left inputsTC) + inputsC (list/map product.right inputsTC)] [outputT outputC] gen-primitive - #let [funcT (type;function inputsT outputT) - partialT (type;function (list;drop partial-args inputsT) outputT) - varT (#;Bound +1) - polyT (<| (type;univ-q +1) - (type;function (list;concat (list (list;take var-idx inputsT) + #let [funcT (type.function inputsT outputT) + partialT (type.function (list.drop partial-args inputsT) outputT) + varT (#.Bound +1) + polyT (<| (type.univ-q +1) + (type.function (list.concat (list (list.take var-idx inputsT) (list varT) - (list;drop (n.inc var-idx) inputsT)))) + (list.drop (n/inc var-idx) inputsT)))) varT) - poly-inputT (maybe;assume (list;nth var-idx inputsT)) - partial-poly-inputsT (list;drop (n.inc var-idx) inputsT) - partial-polyT1 (<| (type;function partial-poly-inputsT) + poly-inputT (maybe.assume (list.nth var-idx inputsT)) + partial-poly-inputsT (list.drop (n/inc var-idx) inputsT) + partial-polyT1 (<| (type.function partial-poly-inputsT) poly-inputT) - partial-polyT2 (<| (type;univ-q +1) - (type;function (#;Cons varT partial-poly-inputsT)) + partial-polyT2 (<| (type.univ-q +1) + (type.function (#.Cons varT partial-poly-inputsT)) varT)]] ($_ seq (test "Can analyse monomorphic type application." - (|> (@common;with-unknown-type - (@;analyse-apply analyse funcT (' []) inputsC)) + (|> (@common.with-unknown-type + (@.analyse-apply analyse funcT (' []) inputsC)) (check-apply outputT full-args))) (test "Can partially apply functions." - (|> (@common;with-unknown-type - (@;analyse-apply analyse funcT (' []) - (list;take partial-args inputsC))) + (|> (@common.with-unknown-type + (@.analyse-apply analyse funcT (' []) + (list.take partial-args inputsC))) (check-apply partialT partial-args))) (test "Can apply polymorphic functions." - (|> (@common;with-unknown-type - (@;analyse-apply analyse polyT (' []) inputsC)) + (|> (@common.with-unknown-type + (@.analyse-apply analyse polyT (' []) inputsC)) (check-apply poly-inputT full-args))) (test "Polymorphic partial application propagates found type-vars." - (|> (@common;with-unknown-type - (@;analyse-apply analyse polyT (' []) - (list;take (n.inc var-idx) inputsC))) - (check-apply partial-polyT1 (n.inc var-idx)))) + (|> (@common.with-unknown-type + (@.analyse-apply analyse polyT (' []) + (list.take (n/inc var-idx) inputsC))) + (check-apply partial-polyT1 (n/inc var-idx)))) (test "Polymorphic partial application preserves quantification for type-vars." - (|> (@common;with-unknown-type - (@;analyse-apply analyse polyT (' []) - (list;take var-idx inputsC))) + (|> (@common.with-unknown-type + (@.analyse-apply analyse polyT (' []) + (list.take var-idx inputsC))) (check-apply partial-polyT2 var-idx))) )))) diff --git a/new-luxc/test/test/luxc/lang/analysis/primitive.lux b/new-luxc/test/test/luxc/lang/analysis/primitive.lux index cf60d64fe..d8ba4561f 100644 --- a/new-luxc/test/test/luxc/lang/analysis/primitive.lux +++ b/new-luxc/test/test/luxc/lang/analysis/primitive.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -11,29 +11,29 @@ (lang [type "type/" Eq<Type>]) test) (luxc ["&" lang] - (lang ["&;" module] + (lang ["&." module] ["~" analysis] - (analysis [";A" expression] + (analysis [".A" expression] ["@" primitive] - ["@;" common]))) - (.. common) + ["@." common]))) + (// common) (test/luxc common)) (context: "Primitives" (<| (times +100) (do @ - [%bool% r;bool - %nat% r;nat - %int% r;int - %deg% r;deg - %frac% r;frac - %text% (r;text +5)] + [%bool% r.bool + %nat% r.nat + %int% r.int + %deg% r.deg + %frac% r.frac + %text% (r.text +5)] (`` ($_ seq (test "Can analyse unit." - (|> (@common;with-unknown-type - @;analyse-unit) - (macro;run (init-compiler [])) - (case> (^ (#e;Success [_type (^code [])])) + (|> (@common.with-unknown-type + @.analyse-unit) + (macro.run (init-compiler [])) + (case> (^ (#e.Success [_type (^code [])])) (type/= Unit _type) _ @@ -41,10 +41,10 @@ ) (~~ (do-template [<desc> <type> <tag> <value> <analyser>] [(test (format "Can analyse " <desc> ".") - (|> (@common;with-unknown-type + (|> (@common.with-unknown-type (<analyser> <value>)) - (macro;run (init-compiler [])) - (case> (#e;Success [_type [_ (<tag> value)]]) + (macro.run (init-compiler [])) + (case> (#e.Success [_type [_ (<tag> value)]]) (and (type/= <type> _type) (is <value> value)) @@ -52,10 +52,10 @@ false)) )] - ["bool" Bool #;Bool %bool% @;analyse-bool] - ["nat" Nat #;Nat %nat% @;analyse-nat] - ["int" Int #;Int %int% @;analyse-int] - ["deg" Deg #;Deg %deg% @;analyse-deg] - ["frac" Frac #;Frac %frac% @;analyse-frac] - ["text" Text #;Text %text% @;analyse-text] + ["bool" Bool #.Bool %bool% @.analyse-bool] + ["nat" Nat #.Nat %nat% @.analyse-nat] + ["int" Int #.Int %int% @.analyse-int] + ["deg" Deg #.Deg %deg% @.analyse-deg] + ["frac" Frac #.Frac %frac% @.analyse-frac] + ["text" Text #.Text %text% @.analyse-text] ))))))) diff --git a/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux b/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux index 91e5267f8..8d2494db7 100644 --- a/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux +++ b/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -14,27 +14,27 @@ (lang [type "type/" Eq<Type>]) test) (luxc ["&" lang] - (lang ["&;" scope] - ["&;" module] + (lang ["&." scope] + ["&." module] ["~" analysis] - (analysis [";A" expression] + (analysis [".A" expression] ["@" procedure] - ["@;" common]) - [";L" eval])) - (../.. common) + ["@." common]) + [".L" eval])) + (/// common) (test/luxc common)) (do-template [<name> <success> <failure>] [(def: (<name> procedure params output-type) (-> Text (List Code) Type Bool) - (|> (&;with-scope - (&;with-type output-type - (@;analyse-procedure analyse evalL;eval procedure params))) - (macro;run (init-compiler [])) - (case> (#e;Success _) + (|> (&.with-scope + (&.with-type output-type + (@.analyse-procedure analyse evalL.eval procedure params))) + (macro.run (init-compiler [])) + (case> (#e.Success _) <success> - (#e;Error error) + (#e.Error error) <failure>)))] [check-success+ true false] @@ -46,7 +46,7 @@ (do @ [[primT primC] gen-primitive [antiT antiC] (|> gen-primitive - (r;filter (|>. product;left (type/= primT) not)))] + (r.filter (|>> product.left (type/= primT) not)))] ($_ seq (test "Can test for reference equality." (check-success+ "lux is" (list primC primC) Bool)) @@ -61,9 +61,9 @@ (context: "Bit procedures" (<| (times +100) (do @ - [subjectC (|> r;nat (:: @ map code;nat)) - signedC (|> r;int (:: @ map code;int)) - paramC (|> r;nat (:: @ map code;nat))] + [subjectC (|> r.nat (:: @ map code.nat)) + signedC (|> r.int (:: @ map code.int)) + paramC (|> r.nat (:: @ map code.nat))] ($_ seq (test "Can count the number of 1 bits in a bit pattern." (check-success+ "lux bit count" (list subjectC) Nat)) @@ -84,8 +84,8 @@ (context: "Nat procedures" (<| (times +100) (do @ - [subjectC (|> r;nat (:: @ map code;nat)) - paramC (|> r;nat (:: @ map code;nat))] + [subjectC (|> r.nat (:: @ map code.nat)) + paramC (|> r.nat (:: @ map code.nat))] ($_ seq (test "Can add natural numbers." (check-success+ "lux nat +" (list subjectC paramC) Nat)) @@ -114,8 +114,8 @@ (context: "Int procedures" (<| (times +100) (do @ - [subjectC (|> r;int (:: @ map code;int)) - paramC (|> r;int (:: @ map code;int))] + [subjectC (|> r.int (:: @ map code.int)) + paramC (|> r.int (:: @ map code.int))] ($_ seq (test "Can add integers." (check-success+ "lux int +" (list subjectC paramC) Int)) @@ -144,9 +144,9 @@ (context: "Deg procedures" (<| (times +100) (do @ - [subjectC (|> r;deg (:: @ map code;deg)) - paramC (|> r;deg (:: @ map code;deg)) - natC (|> r;nat (:: @ map code;nat))] + [subjectC (|> r.deg (:: @ map code.deg)) + paramC (|> r.deg (:: @ map code.deg)) + natC (|> r.nat (:: @ map code.nat))] ($_ seq (test "Can add degrees." (check-success+ "lux deg +" (list subjectC paramC) Deg)) @@ -177,9 +177,9 @@ (context: "Frac procedures" (<| (times +100) (do @ - [subjectC (|> r;frac (:: @ map code;frac)) - paramC (|> r;frac (:: @ map code;frac)) - encodedC (|> (r;text +5) (:: @ map code;text))] + [subjectC (|> r.frac (:: @ map code.frac)) + paramC (|> r.frac (:: @ map code.frac)) + encodedC (|> (r.text +5) (:: @ map code.text))] ($_ seq (test "Can add frac numbers." (check-success+ "lux frac +" (list subjectC paramC) Frac)) @@ -220,11 +220,11 @@ (context: "Text procedures" (<| (times +100) (do @ - [subjectC (|> (r;text +5) (:: @ map code;text)) - paramC (|> (r;text +5) (:: @ map code;text)) - replacementC (|> (r;text +5) (:: @ map code;text)) - fromC (|> r;nat (:: @ map code;nat)) - toC (|> r;nat (:: @ map code;nat))] + [subjectC (|> (r.text +5) (:: @ map code.text)) + paramC (|> (r.text +5) (:: @ map code.text)) + replacementC (|> (r.text +5) (:: @ map code.text)) + fromC (|> r.nat (:: @ map code.nat)) + toC (|> r.nat (:: @ map code.nat))] ($_ seq (test "Can test text equality." (check-success+ "lux text =" (list subjectC paramC) Bool)) @@ -252,72 +252,72 @@ (<| (times +100) (do @ [[elemT elemC] gen-primitive - sizeC (|> r;nat (:: @ map code;nat)) - idxC (|> r;nat (:: @ map code;nat)) - var-name (r;text +5) + sizeC (|> r.nat (:: @ map code.nat)) + idxC (|> r.nat (:: @ map code.nat)) + var-name (r.text +5) #let [arrayT (type (Array elemT))]] ($_ seq (test "Can create arrays." (check-success+ "lux array new" (list sizeC) arrayT)) (test "Can get a value inside an array." - (|> (&scope;with-scope "" - (&scope;with-local [var-name arrayT] - (&;with-type elemT - (@;analyse-procedure analyse evalL;eval "lux array get" + (|> (&scope.with-scope "" + (&scope.with-local [var-name arrayT] + (&.with-type elemT + (@.analyse-procedure analyse evalL.eval "lux array get" (list idxC - (code;symbol ["" var-name])))))) - (macro;run (init-compiler [])) - (case> (#e;Success _) + (code.symbol ["" var-name])))))) + (macro.run (init-compiler [])) + (case> (#e.Success _) true - (#e;Error _) + (#e.Error _) false))) (test "Can put a value inside an array." - (|> (&scope;with-scope "" - (&scope;with-local [var-name arrayT] - (&;with-type arrayT - (@;analyse-procedure analyse evalL;eval "lux array put" + (|> (&scope.with-scope "" + (&scope.with-local [var-name arrayT] + (&.with-type arrayT + (@.analyse-procedure analyse evalL.eval "lux array put" (list idxC elemC - (code;symbol ["" var-name])))))) - (macro;run (init-compiler [])) - (case> (#e;Success _) + (code.symbol ["" var-name])))))) + (macro.run (init-compiler [])) + (case> (#e.Success _) true - (#e;Error _) + (#e.Error _) false))) (test "Can remove a value from an array." - (|> (&scope;with-scope "" - (&scope;with-local [var-name arrayT] - (&;with-type arrayT - (@;analyse-procedure analyse evalL;eval "lux array remove" + (|> (&scope.with-scope "" + (&scope.with-local [var-name arrayT] + (&.with-type arrayT + (@.analyse-procedure analyse evalL.eval "lux array remove" (list idxC - (code;symbol ["" var-name])))))) - (macro;run (init-compiler [])) - (case> (#e;Success _) + (code.symbol ["" var-name])))))) + (macro.run (init-compiler [])) + (case> (#e.Success _) true - (#e;Error _) + (#e.Error _) false))) (test "Can query the size of an array." - (|> (&scope;with-scope "" - (&scope;with-local [var-name arrayT] - (&;with-type Nat - (@;analyse-procedure analyse evalL;eval "lux array size" - (list (code;symbol ["" var-name])))))) - (macro;run (init-compiler [])) - (case> (#e;Success _) + (|> (&scope.with-scope "" + (&scope.with-local [var-name arrayT] + (&.with-type Nat + (@.analyse-procedure analyse evalL.eval "lux array size" + (list (code.symbol ["" var-name])))))) + (macro.run (init-compiler [])) + (case> (#e.Success _) true - (#e;Error _) + (#e.Error _) false))) )))) (context: "Math procedures" (<| (times +100) (do @ - [subjectC (|> r;frac (:: @ map code;frac)) - paramC (|> r;frac (:: @ map code;frac))] + [subjectC (|> r.frac (:: @ map code.frac)) + paramC (|> r.frac (:: @ map code.frac))] (with-expansions [<unary> (do-template [<proc> <desc>] [(test (format "Can calculate " <desc> ".") (check-success+ <proc> (list subjectC) Frac))] @@ -352,38 +352,38 @@ (<| (times +100) (do @ [[elemT elemC] gen-primitive - sizeC (|> r;nat (:: @ map code;nat)) - idxC (|> r;nat (:: @ map code;nat)) - var-name (r;text +5) - #let [atomT (type (atom;Atom elemT))]] + sizeC (|> r.nat (:: @ map code.nat)) + idxC (|> r.nat (:: @ map code.nat)) + var-name (r.text +5) + #let [atomT (type (atom.Atom elemT))]] ($_ seq (test "Can create atomic reference." (check-success+ "lux atom new" (list elemC) atomT)) (test "Can read the value of an atomic reference." - (|> (&scope;with-scope "" - (&scope;with-local [var-name atomT] - (&;with-type elemT - (@;analyse-procedure analyse evalL;eval "lux atom read" - (list (code;symbol ["" var-name])))))) - (macro;run (init-compiler [])) - (case> (#e;Success _) + (|> (&scope.with-scope "" + (&scope.with-local [var-name atomT] + (&.with-type elemT + (@.analyse-procedure analyse evalL.eval "lux atom read" + (list (code.symbol ["" var-name])))))) + (macro.run (init-compiler [])) + (case> (#e.Success _) true - (#e;Error _) + (#e.Error _) false))) (test "Can swap the value of an atomic reference." - (|> (&scope;with-scope "" - (&scope;with-local [var-name atomT] - (&;with-type Bool - (@;analyse-procedure analyse evalL;eval "lux atom compare-and-swap" + (|> (&scope.with-scope "" + (&scope.with-local [var-name atomT] + (&.with-type Bool + (@.analyse-procedure analyse evalL.eval "lux atom compare-and-swap" (list elemC elemC - (code;symbol ["" var-name])))))) - (macro;run (init-compiler [])) - (case> (#e;Success _) + (code.symbol ["" var-name])))))) + (macro.run (init-compiler [])) + (case> (#e.Success _) true - (#e;Error _) + (#e.Error _) false))) )))) @@ -391,7 +391,7 @@ (<| (times +100) (do @ [[primT primC] gen-primitive - timeC (|> r;nat (:: @ map code;nat))] + timeC (|> r.nat (:: @ map code.nat))] ($_ seq (test "Can query the level of concurrency." (check-success+ "lux process concurrency-level" (list) Nat)) @@ -409,8 +409,8 @@ (context: "IO procedures" (<| (times +100) (do @ - [logC (|> (r;text +5) (:: @ map code;text)) - exitC (|> r;nat (:: @ map code;nat))] + [logC (|> (r.text +5) (:: @ map code.text)) + exitC (|> r.nat (:: @ map code.nat))] ($_ seq (test "Can log messages to standard output." (check-success+ "lux io log" (list logC) Unit)) diff --git a/new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux b/new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux index 13645840e..72d1e8bc9 100644 --- a/new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux +++ b/new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -18,31 +18,31 @@ (lang [type]) test) (luxc ["&" lang] - (lang ["&;" scope] - ["&;" module] + (lang ["&." scope] + ["&." module] ["~" analysis] - (analysis [";A" expression] - ["@;" common] + (analysis [".A" expression] + ["@." common] ["@" procedure] - (procedure ["@;" host])) - (translation ["@;" runtime]) - [";L" eval])) - (../.. common) + (procedure ["@." host])) + (translation ["@." runtime]) + [".L" eval])) + (/// common) (test/luxc common)) (do-template [<name> <success> <failure>] [(def: (<name> procedure params output-type) (-> Text (List Code) Type Bool) (|> (do Monad<Meta> - [runtime-bytecode @runtime;translate] - (&;with-scope - (&;with-type output-type - (@;analyse-procedure analyse evalL;eval procedure params)))) - (macro;run (init-compiler [])) - (case> (#e;Success _) + [runtime-bytecode @runtime.translate] + (&.with-scope + (&.with-type output-type + (@.analyse-procedure analyse evalL.eval procedure params)))) + (macro.run (init-compiler [])) + (case> (#e.Success _) <success> - (#e;Error error) + (#e.Error error) <failure>)))] [success true false] @@ -56,12 +56,12 @@ (test (format <procedure> " FAILURE") (failure <procedure> (list (' [])) <to>))] - ["jvm convert double-to-float" "java.lang.Double" @host;Float] - ["jvm convert double-to-int" "java.lang.Double" @host;Integer] - ["jvm convert double-to-long" "java.lang.Double" @host;Long] - ["jvm convert float-to-double" "java.lang.Float" @host;Double] - ["jvm convert float-to-int" "java.lang.Float" @host;Integer] - ["jvm convert float-to-long" "java.lang.Float" @host;Long] + ["jvm convert double-to-float" "java.lang.Double" @host.Float] + ["jvm convert double-to-int" "java.lang.Double" @host.Integer] + ["jvm convert double-to-long" "java.lang.Double" @host.Long] + ["jvm convert float-to-double" "java.lang.Float" @host.Double] + ["jvm convert float-to-int" "java.lang.Float" @host.Integer] + ["jvm convert float-to-long" "java.lang.Float" @host.Long] )] ($_ seq <conversions> @@ -74,12 +74,12 @@ (test (format <procedure> " FAILURE") (failure <procedure> (list (' [])) <to>))] - ["jvm convert int-to-byte" "java.lang.Integer" @host;Byte] - ["jvm convert int-to-char" "java.lang.Integer" @host;Character] - ["jvm convert int-to-double" "java.lang.Integer" @host;Double] - ["jvm convert int-to-float" "java.lang.Integer" @host;Float] - ["jvm convert int-to-long" "java.lang.Integer" @host;Long] - ["jvm convert int-to-short" "java.lang.Integer" @host;Short] + ["jvm convert int-to-byte" "java.lang.Integer" @host.Byte] + ["jvm convert int-to-char" "java.lang.Integer" @host.Character] + ["jvm convert int-to-double" "java.lang.Integer" @host.Double] + ["jvm convert int-to-float" "java.lang.Integer" @host.Float] + ["jvm convert int-to-long" "java.lang.Integer" @host.Long] + ["jvm convert int-to-short" "java.lang.Integer" @host.Short] )] ($_ seq <conversions> @@ -92,11 +92,11 @@ (test (format <procedure> " FAILURE") (failure <procedure> (list (' [])) <to>))] - ["jvm convert long-to-double" "java.lang.Long" @host;Double] - ["jvm convert long-to-float" "java.lang.Long" @host;Float] - ["jvm convert long-to-int" "java.lang.Long" @host;Integer] - ["jvm convert long-to-short" "java.lang.Long" @host;Short] - ["jvm convert long-to-byte" "java.lang.Long" @host;Byte] + ["jvm convert long-to-double" "java.lang.Long" @host.Double] + ["jvm convert long-to-float" "java.lang.Long" @host.Float] + ["jvm convert long-to-int" "java.lang.Long" @host.Integer] + ["jvm convert long-to-short" "java.lang.Long" @host.Short] + ["jvm convert long-to-byte" "java.lang.Long" @host.Byte] )] ($_ seq <conversions> @@ -109,12 +109,12 @@ (test (format <procedure> " FAILURE") (failure <procedure> (list (' [])) <to>))] - ["jvm convert char-to-byte" "java.lang.Character" @host;Byte] - ["jvm convert char-to-short" "java.lang.Character" @host;Short] - ["jvm convert char-to-int" "java.lang.Character" @host;Integer] - ["jvm convert char-to-long" "java.lang.Character" @host;Long] - ["jvm convert byte-to-long" "java.lang.Byte" @host;Long] - ["jvm convert short-to-long" "java.lang.Short" @host;Long] + ["jvm convert char-to-byte" "java.lang.Character" @host.Byte] + ["jvm convert char-to-short" "java.lang.Character" @host.Short] + ["jvm convert char-to-int" "java.lang.Character" @host.Integer] + ["jvm convert char-to-long" "java.lang.Character" @host.Long] + ["jvm convert byte-to-long" "java.lang.Byte" @host.Long] + ["jvm convert short-to-long" "java.lang.Short" @host.Long] )] ($_ seq <conversions> @@ -147,8 +147,8 @@ (' ("lux coerce" (+0 <param> (+0)) []))) <output>))] - [(format "jvm " <domain> " =") <boxed> <boxed> @host;Boolean] - [(format "jvm " <domain> " <") <boxed> <boxed> @host;Boolean] + [(format "jvm " <domain> " =") <boxed> <boxed> @host.Boolean] + [(format "jvm " <domain> " <") <boxed> <boxed> @host.Boolean] )] ($_ seq <instructions> @@ -174,8 +174,8 @@ )))] - ["int" "java.lang.Integer" @host;Integer] - ["long" "java.lang.Long" @host;Long] + ["int" "java.lang.Integer" @host.Integer] + ["long" "java.lang.Long" @host.Long] ) (do-template [<domain> <boxed> <type>] @@ -205,16 +205,16 @@ (' ("lux coerce" (+0 <param> (+0)) []))) <output>))] - [(format "jvm " <domain> " =") <boxed> <boxed> @host;Boolean] - [(format "jvm " <domain> " <") <boxed> <boxed> @host;Boolean] + [(format "jvm " <domain> " =") <boxed> <boxed> @host.Boolean] + [(format "jvm " <domain> " <") <boxed> <boxed> @host.Boolean] )] ($_ seq <instructions> )))] - ["float" "java.lang.Float" @host;Float] - ["double" "java.lang.Double" @host;Double] + ["float" "java.lang.Float" @host.Float] + ["double" "java.lang.Double" @host.Double] ) (do-template [<domain> <boxed> <type>] @@ -226,59 +226,59 @@ (' ("lux coerce" (+0 <param> (+0)) []))) <output>))] - [(format "jvm " <domain> " =") <boxed> <boxed> @host;Boolean] - [(format "jvm " <domain> " <") <boxed> <boxed> @host;Boolean] + [(format "jvm " <domain> " =") <boxed> <boxed> @host.Boolean] + [(format "jvm " <domain> " <") <boxed> <boxed> @host.Boolean] )] ($_ seq <instructions> )))] - ["char" "java.lang.Character" @host;Character] + ["char" "java.lang.Character" @host.Character] ) (def: array-type - (r;Random [Text Text]) - (let [entries (dict;entries @host;boxes) - num-entries (list;size entries)] - (do r;Monad<Random> - [choice (|> r;nat (:: @ map (n.% (n.inc num-entries)))) + (r.Random [Text Text]) + (let [entries (dict.entries @host.boxes) + num-entries (list.size entries)] + (do r.Monad<Random> + [choice (|> r.nat (:: @ map (n/% (n/inc num-entries)))) #let [[unboxed boxed] (: [Text Text] (|> entries - (list;nth choice) - (maybe;default ["java.lang.Object" "java.lang.Object"])))]] + (list.nth choice) + (maybe.default ["java.lang.Object" "java.lang.Object"])))]] (wrap [unboxed boxed])))) (context: "Array." (<| (times +100) (do @ - [#let [cap (|>. (n.% +10) (n.max +1))] + [#let [cap (|>> (n/% +10) (n/max +1))] [unboxed boxed] array-type - size (|> r;nat (:: @ map cap)) - idx (|> r;nat (:: @ map (n.% size))) - level (|> r;nat (:: @ map cap)) - #let [unboxedT (#;Primitive unboxed (list)) - arrayT (#;Primitive "#Array" (list unboxedT)) - arrayC (`' ("lux check" (+0 "#Array" (+1 (+0 (~ (code;text unboxed)) (+0)) (+0))) - ("jvm array new" (~ (code;nat size))))) - boxedT (#;Primitive boxed (list)) - boxedTC (` (+0 (~ (code;text boxed)) (+0))) + size (|> r.nat (:: @ map cap)) + idx (|> r.nat (:: @ map (n/% size))) + level (|> r.nat (:: @ map cap)) + #let [unboxedT (#.Primitive unboxed (list)) + arrayT (#.Primitive "#Array" (list unboxedT)) + arrayC (`' ("lux check" (+0 "#Array" (+1 (+0 (~ (code.text unboxed)) (+0)) (+0))) + ("jvm array new" (~ (code.nat size))))) + boxedT (#.Primitive boxed (list)) + boxedTC (` (+0 (~ (code.text boxed)) (+0))) multi-arrayT (list/fold (function [_ innerT] - (|> innerT (list) (#;Primitive "#Array"))) + (|> innerT (list) (#.Primitive "#Array"))) boxedT - (list;n.range +1 level))]] + (list.n/range +1 level))]] ($_ seq (test "jvm array new" (success "jvm array new" - (list (code;nat size)) + (list (code.nat size)) arrayT)) (test "jvm array new (no nesting)" (failure "jvm array new" - (list (code;nat size)) + (list (code.nat size)) unboxedT)) (test "jvm array new (nested/multi-level)" (success "jvm array new" - (list (code;nat size)) + (list (code.nat size)) multi-arrayT)) (test "jvm array length" (success "jvm array length" @@ -286,11 +286,11 @@ Nat)) (test "jvm array read" (success "jvm array read" - (list arrayC (code;nat idx)) + (list arrayC (code.nat idx)) boxedT)) (test "jvm array write" (success "jvm array write" - (list arrayC (code;nat idx) (`' ("lux coerce" (~ boxedTC) []))) + (list arrayC (code.nat idx) (`' ("lux coerce" (~ boxedTC) []))) arrayT)) )))) @@ -309,33 +309,33 @@ (do @ [[unboxed boxed] array-type [!unboxed !boxed] (|> array-type - (r;filter (function [[!unboxed !boxed]] + (r.filter (function [[!unboxed !boxed]] (not (text/= boxed !boxed))))) - #let [boxedT (#;Primitive boxed (list)) - boxedC (`' ("lux check" (+0 (~ (code;text boxed)) (+0)) + #let [boxedT (#.Primitive boxed (list)) + boxedC (`' ("lux check" (+0 (~ (code.text boxed)) (+0)) ("jvm object null"))) - !boxedC (`' ("lux check" (+0 (~ (code;text !boxed)) (+0)) + !boxedC (`' ("lux check" (+0 (~ (code.text !boxed)) (+0)) ("jvm object null"))) - unboxedC (`' ("lux check" (+0 (~ (code;text unboxed)) (+0)) + unboxedC (`' ("lux check" (+0 (~ (code.text unboxed)) (+0)) ("jvm object null")))] - throwable (|> r;nat - (:: @ map (n.% (n.inc (list;size throwables)))) + throwable (|> r.nat + (:: @ map (n/% (n/inc (list.size throwables)))) (:: @ map (function [idx] (|> throwables - (list;nth idx) - (maybe;default "java.lang.Object"))))) - #let [throwableC (`' ("lux check" (+0 (~ (code;text throwable)) (+0)) + (list.nth idx) + (maybe.default "java.lang.Object"))))) + #let [throwableC (`' ("lux check" (+0 (~ (code.text throwable)) (+0)) ("jvm object null")))]] ($_ seq (test "jvm object null" (success "jvm object null" (list) - (#;Primitive boxed (list)))) + (#.Primitive boxed (list)))) (test "jvm object null (no primitives)" (or (text/= "java.lang.Object" boxed) (failure "jvm object null" (list) - (#;Primitive unboxed (list))))) + (#.Primitive unboxed (list))))) (test "jvm object null?" (success "jvm object null?" (list boxedC) @@ -356,11 +356,11 @@ Bottom))) (test "jvm object class" (success "jvm object class" - (list (code;text boxed)) - (#;Primitive "java.lang.Class" (list boxedT)))) + (list (code.text boxed)) + (#.Primitive "java.lang.Class" (list boxedT)))) (test "jvm object instance?" (success "jvm object instance?" - (list (code;text boxed) + (list (code.text boxed) boxedC) Bool)) (test "jvm object instance? (lineage)" @@ -371,7 +371,7 @@ (test "jvm object instance? (no lineage)" (or (text/= "java.lang.Object" boxed) (failure "jvm object instance?" - (list (code;text boxed) + (list (code.text boxed) !boxedC) Bool))) )))) @@ -380,32 +380,32 @@ ($_ seq (test "jvm member static get" (success "jvm member static get" - (list (code;text "java.lang.System") - (code;text "out")) - (#;Primitive "java.io.PrintStream" (list)))) + (list (code.text "java.lang.System") + (code.text "out")) + (#.Primitive "java.io.PrintStream" (list)))) (test "jvm member static get (inheritance out)" (success "jvm member static get" - (list (code;text "java.lang.System") - (code;text "out")) - (#;Primitive "java.lang.Object" (list)))) + (list (code.text "java.lang.System") + (code.text "out")) + (#.Primitive "java.lang.Object" (list)))) (test "jvm member static put" (success "jvm member static put" - (list (code;text "java.awt.datatransfer.DataFlavor") - (code;text "allHtmlFlavor") + (list (code.text "java.awt.datatransfer.DataFlavor") + (code.text "allHtmlFlavor") (`' ("lux check" (+0 "java.awt.datatransfer.DataFlavor" (+0)) ("jvm object null")))) Unit)) (test "jvm member static put (final)" (failure "jvm member static put" - (list (code;text "java.lang.System") - (code;text "out") + (list (code.text "java.lang.System") + (code.text "out") (`' ("lux check" (+0 "java.io.PrintStream" (+0)) ("jvm object null")))) Unit)) (test "jvm member static put (inheritance in)" (success "jvm member static put" - (list (code;text "java.awt.datatransfer.DataFlavor") - (code;text "allHtmlFlavor") + (list (code.text "java.awt.datatransfer.DataFlavor") + (code.text "allHtmlFlavor") (`' ("lux check" (+0 "javax.activation.ActivationDataFlavor" (+0)) ("jvm object null")))) Unit)) @@ -415,70 +415,70 @@ ($_ seq (test "jvm member virtual get" (success "jvm member virtual get" - (list (code;text "org.omg.CORBA.ValueMember") - (code;text "id") + (list (code.text "org.omg.CORBA.ValueMember") + (code.text "id") (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0)) ("jvm object null")))) - (#;Primitive "java.lang.String" (list)))) + (#.Primitive "java.lang.String" (list)))) (test "jvm member virtual get (inheritance out)" (success "jvm member virtual get" - (list (code;text "org.omg.CORBA.ValueMember") - (code;text "id") + (list (code.text "org.omg.CORBA.ValueMember") + (code.text "id") (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0)) ("jvm object null")))) - (#;Primitive "java.lang.Object" (list)))) + (#.Primitive "java.lang.Object" (list)))) (test "jvm member virtual put" (success "jvm member virtual put" - (list (code;text "org.omg.CORBA.ValueMember") - (code;text "id") + (list (code.text "org.omg.CORBA.ValueMember") + (code.text "id") (`' ("lux check" (+0 "java.lang.String" (+0)) ("jvm object null"))) (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0)) ("jvm object null")))) - (primitive org.omg.CORBA.ValueMember))) + (primitive "org.omg.CORBA.ValueMember"))) (test "jvm member virtual put (final)" (failure "jvm member virtual put" - (list (code;text "javax.swing.text.html.parser.DTD") - (code;text "applet") + (list (code.text "javax.swing.text.html.parser.DTD") + (code.text "applet") (`' ("lux check" (+0 "javax.swing.text.html.parser.Element" (+0)) ("jvm object null"))) (`' ("lux check" (+0 "javax.swing.text.html.parser.DTD" (+0)) ("jvm object null")))) - (primitive javax.swing.text.html.parser.DTD))) + (primitive "javax.swing.text.html.parser.DTD"))) (test "jvm member virtual put (inheritance in)" (success "jvm member virtual put" - (list (code;text "java.awt.GridBagConstraints") - (code;text "insets") + (list (code.text "java.awt.GridBagConstraints") + (code.text "insets") (`' ("lux check" (+0 "javax.swing.plaf.InsetsUIResource" (+0)) ("jvm object null"))) (`' ("lux check" (+0 "java.awt.GridBagConstraints" (+0)) ("jvm object null")))) - (primitive java.awt.GridBagConstraints))) + (primitive "java.awt.GridBagConstraints"))) )) (context: "Boxing/Unboxing." ($_ seq (test "jvm member static get" (success "jvm member static get" - (list (code;text "java.util.GregorianCalendar") - (code;text "AD")) - (#;Primitive "java.lang.Integer" (list)))) + (list (code.text "java.util.GregorianCalendar") + (code.text "AD")) + (#.Primitive "java.lang.Integer" (list)))) (test "jvm member virtual get" (success "jvm member virtual get" - (list (code;text "javax.accessibility.AccessibleAttributeSequence") - (code;text "startIndex") + (list (code.text "javax.accessibility.AccessibleAttributeSequence") + (code.text "startIndex") (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0)) ("jvm object null")))) - (#;Primitive "java.lang.Integer" (list)))) + (#.Primitive "java.lang.Integer" (list)))) (test "jvm member virtual put" (success "jvm member virtual put" - (list (code;text "javax.accessibility.AccessibleAttributeSequence") - (code;text "startIndex") + (list (code.text "javax.accessibility.AccessibleAttributeSequence") + (code.text "startIndex") (`' ("lux check" (+0 "java.lang.Integer" (+0)) ("jvm object null"))) (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0)) ("jvm object null")))) - (primitive javax.accessibility.AccessibleAttributeSequence))) + (primitive "javax.accessibility.AccessibleAttributeSequence"))) )) (context: "Member [Method]." @@ -491,39 +491,39 @@ ($_ seq (test "jvm member invoke static" (success "jvm member invoke static" - (list (code;text "java.lang.Long") - (code;text "decode") - (code;tuple (list (' "java.lang.String") + (list (code.text "java.lang.Long") + (code.text "decode") + (code.tuple (list (' "java.lang.String") (' ("lux coerce" (+0 "java.lang.String" (+0)) "YOLO"))))) - (#;Primitive "java.lang.Long" (list)))) + (#.Primitive "java.lang.Long" (list)))) (test "jvm member invoke virtual" (success "jvm member invoke virtual" - (list (code;text "java.lang.Object") - (code;text "equals") + (list (code.text "java.lang.Object") + (code.text "equals") longC - (code;tuple (list (' "java.lang.Object") + (code.tuple (list (' "java.lang.Object") longC))) - (#;Primitive "java.lang.Boolean" (list)))) + (#.Primitive "java.lang.Boolean" (list)))) (test "jvm member invoke special" (success "jvm member invoke special" - (list (code;text "java.lang.Long") - (code;text "equals") + (list (code.text "java.lang.Long") + (code.text "equals") longC - (code;tuple (list (' "java.lang.Object") + (code.tuple (list (' "java.lang.Object") longC))) - (#;Primitive "java.lang.Boolean" (list)))) + (#.Primitive "java.lang.Boolean" (list)))) (test "jvm member invoke interface" (success "jvm member invoke interface" - (list (code;text "java.util.Collection") - (code;text "add") + (list (code.text "java.util.Collection") + (code.text "add") objectC - (code;tuple (list (' "java.lang.Object") + (code.tuple (list (' "java.lang.Object") longC))) - (#;Primitive "java.lang.Boolean" (list)))) + (#.Primitive "java.lang.Boolean" (list)))) (test "jvm member invoke constructor" (success "jvm member invoke constructor" - (list (code;text "java.util.ArrayList") - (code;tuple (list (' "int") intC))) - (All [a] (#;Primitive "java.util.ArrayList" (list a))))) + (list (code.text "java.util.ArrayList") + (code.tuple (list (' "int") intC))) + (All [a] (#.Primitive "java.util.ArrayList" (list a))))) ))) diff --git a/new-luxc/test/test/luxc/lang/analysis/reference.lux b/new-luxc/test/test/luxc/lang/analysis/reference.lux index 14079c6b8..45e1eb0e8 100644 --- a/new-luxc/test/test/luxc/lang/analysis/reference.lux +++ b/new-luxc/test/test/luxc/lang/analysis/reference.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -8,43 +8,43 @@ [macro #+ Monad<Meta>] (lang [type "type/" Eq<Type>]) test) - (luxc (lang ["&;" scope] - ["&;" module] + (luxc (lang ["&." scope] + ["&." module] ["~" analysis] - (analysis [";A" expression] + (analysis [".A" expression] ["@" reference] - ["@;" common]))) - (.. common) + ["@." common]))) + (// common) (test/luxc common)) (context: "References" (<| (times +100) (do @ [[ref-type _] gen-primitive - module-name (r;text +5) - scope-name (r;text +5) - var-name (r;text +5)] + module-name (r.text +5) + scope-name (r.text +5) + var-name (r.text +5)] ($_ seq (test "Can analyse variable." - (|> (&scope;with-scope scope-name - (&scope;with-local [var-name ref-type] - (@common;with-unknown-type - (@;analyse-reference ["" var-name])))) - (macro;run (init-compiler [])) - (case> (^ (#e;Success [_type (^code ((~ [_ (#;Int var)])))])) + (|> (&scope.with-scope scope-name + (&scope.with-local [var-name ref-type] + (@common.with-unknown-type + (@.analyse-reference ["" var-name])))) + (macro.run (init-compiler [])) + (case> (^ (#e.Success [_type (^code ((~ [_ (#.Int var)])))])) (type/= ref-type _type) _ false))) (test "Can analyse definition." (|> (do Monad<Meta> - [_ (&module;create +0 module-name) - _ (&module;define [module-name var-name] + [_ (&module.create +0 module-name) + _ (&module.define [module-name var-name] [ref-type (' {}) (:! Void [])])] - (@common;with-unknown-type - (@;analyse-reference [module-name var-name]))) - (macro;run (init-compiler [])) - (case> (#e;Success [_type [_ (#;Symbol def-name)]]) + (@common.with-unknown-type + (@.analyse-reference [module-name var-name]))) + (macro.run (init-compiler [])) + (case> (#e.Success [_type [_ (#.Symbol def-name)]]) (type/= ref-type _type) _ diff --git a/new-luxc/test/test/luxc/lang/analysis/structure.lux b/new-luxc/test/test/luxc/lang/analysis/structure.lux index 58212359e..5694c0927 100644 --- a/new-luxc/test/test/luxc/lang/analysis/structure.lux +++ b/new-luxc/test/test/luxc/lang/analysis/structure.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -18,196 +18,196 @@ (type ["tc" check])) test) (luxc ["&" lang] - (lang ["@;" module] + (lang ["@." module] ["la" analysis] - (analysis [";A" expression] + (analysis [".A" expression] ["@" structure] - ["@;" common]))) - (.. common) + ["@." common]))) + (// common) (test/luxc common)) (context: "Sums" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) - choice (|> r;nat (:: @ map (n.% size))) - primitives (r;list size gen-primitive) - +choice (|> r;nat (:: @ map (n.% (n.inc size)))) + [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2)))) + choice (|> r.nat (:: @ map (n/% size))) + primitives (r.list size gen-primitive) + +choice (|> r.nat (:: @ map (n/% (n/inc size)))) [_ +valueC] gen-primitive - #let [variantT (type;variant (list/map product;left primitives)) - [valueT valueC] (maybe;assume (list;nth choice primitives)) - +size (n.inc size) - +primitives (list;concat (list (list;take choice primitives) - (list [(#;Bound +1) +valueC]) - (list;drop choice primitives))) - [+valueT +valueC] (maybe;assume (list;nth +choice +primitives)) - +variantT (type;variant (list/map product;left +primitives))]] + #let [variantT (type.variant (list/map product.left primitives)) + [valueT valueC] (maybe.assume (list.nth choice primitives)) + +size (n/inc size) + +primitives (list.concat (list (list.take choice primitives) + (list [(#.Bound +1) +valueC]) + (list.drop choice primitives))) + [+valueT +valueC] (maybe.assume (list.nth +choice +primitives)) + +variantT (type.variant (list/map product.left +primitives))]] ($_ seq (test "Can analyse sum." - (|> (&;with-scope - (&;with-type variantT - (@;analyse-sum analyse choice valueC))) - (macro;run (init-compiler [])) - (case> (^multi (#e;Success [_ sumA]) - [(la;unfold-variant sumA) - (#;Some [tag last? valueA])]) - (and (n.= tag choice) - (bool/= last? (n.= (n.dec size) choice))) + (|> (&.with-scope + (&.with-type variantT + (@.analyse-sum analyse choice valueC))) + (macro.run (init-compiler [])) + (case> (^multi (#e.Success [_ sumA]) + [(la.unfold-variant sumA) + (#.Some [tag last? valueA])]) + (and (n/= tag choice) + (bool/= last? (n/= (n/dec size) choice))) _ false))) (test "Can analyse sum through bound type-vars." - (|> (&;with-scope - (do macro;Monad<Meta> - [[_ varT] (&;with-type-env tc;var) - _ (&;with-type-env - (tc;check varT variantT))] - (&;with-type varT - (@;analyse-sum analyse choice valueC)))) - (macro;run (init-compiler [])) - (case> (^multi (#e;Success [_ sumA]) - [(la;unfold-variant sumA) - (#;Some [tag last? valueA])]) - (and (n.= tag choice) - (bool/= last? (n.= (n.dec size) choice))) + (|> (&.with-scope + (do macro.Monad<Meta> + [[_ varT] (&.with-type-env tc.var) + _ (&.with-type-env + (tc.check varT variantT))] + (&.with-type varT + (@.analyse-sum analyse choice valueC)))) + (macro.run (init-compiler [])) + (case> (^multi (#e.Success [_ sumA]) + [(la.unfold-variant sumA) + (#.Some [tag last? valueA])]) + (and (n/= tag choice) + (bool/= last? (n/= (n/dec size) choice))) _ false))) (test "Cannot analyse sum through unbound type-vars." - (|> (&;with-scope - (do macro;Monad<Meta> - [[_ varT] (&;with-type-env tc;var)] - (&;with-type varT - (@;analyse-sum analyse choice valueC)))) - (macro;run (init-compiler [])) - (case> (#e;Success _) + (|> (&.with-scope + (do macro.Monad<Meta> + [[_ varT] (&.with-type-env tc.var)] + (&.with-type varT + (@.analyse-sum analyse choice valueC)))) + (macro.run (init-compiler [])) + (case> (#e.Success _) false _ true))) (test "Can analyse sum through existential quantification." - (|> (&;with-scope - (&;with-type (type;ex-q +1 +variantT) - (@;analyse-sum analyse +choice +valueC))) - (macro;run (init-compiler [])) - (case> (#e;Success _) + (|> (&.with-scope + (&.with-type (type.ex-q +1 +variantT) + (@.analyse-sum analyse +choice +valueC))) + (macro.run (init-compiler [])) + (case> (#e.Success _) true - (#e;Error error) + (#e.Error error) false))) (test "Can analyse sum through universal quantification." - (|> (&;with-scope - (&;with-type (type;univ-q +1 +variantT) - (@;analyse-sum analyse +choice +valueC))) - (macro;run (init-compiler [])) - (case> (#e;Success _) - (not (n.= choice +choice)) + (|> (&.with-scope + (&.with-type (type.univ-q +1 +variantT) + (@.analyse-sum analyse +choice +valueC))) + (macro.run (init-compiler [])) + (case> (#e.Success _) + (not (n/= choice +choice)) - (#e;Error error) - (n.= choice +choice)))) + (#e.Error error) + (n/= choice +choice)))) )))) (context: "Products" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) - primitives (r;list size gen-primitive) - choice (|> r;nat (:: @ map (n.% size))) + [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2)))) + primitives (r.list size gen-primitive) + choice (|> r.nat (:: @ map (n/% size))) [_ +valueC] gen-primitive - #let [[singletonT singletonC] (|> primitives (list;nth choice) maybe;assume) - +primitives (list;concat (list (list;take choice primitives) - (list [(#;Bound +1) +valueC]) - (list;drop choice primitives))) - +tupleT (type;tuple (list/map product;left +primitives))]] + #let [[singletonT singletonC] (|> primitives (list.nth choice) maybe.assume) + +primitives (list.concat (list (list.take choice primitives) + (list [(#.Bound +1) +valueC]) + (list.drop choice primitives))) + +tupleT (type.tuple (list/map product.left +primitives))]] ($_ seq (test "Can analyse product." - (|> (&;with-type (type;tuple (list/map product;left primitives)) - (@;analyse-product analyse (list/map product;right primitives))) - (macro;run (init-compiler [])) - (case> (#e;Success tupleA) - (n.= size (list;size (la;unfold-tuple tupleA))) + (|> (&.with-type (type.tuple (list/map product.left primitives)) + (@.analyse-product analyse (list/map product.right primitives))) + (macro.run (init-compiler [])) + (case> (#e.Success tupleA) + (n/= size (list.size (la.unfold-tuple tupleA))) _ false))) (test "Can infer product." - (|> (@common;with-unknown-type - (@;analyse-product analyse (list/map product;right primitives))) - (macro;run (init-compiler [])) - (case> (#e;Success [_type tupleA]) - (and (type/= (type;tuple (list/map product;left primitives)) + (|> (@common.with-unknown-type + (@.analyse-product analyse (list/map product.right primitives))) + (macro.run (init-compiler [])) + (case> (#e.Success [_type tupleA]) + (and (type/= (type.tuple (list/map product.left primitives)) _type) - (n.= size (list;size (la;unfold-tuple tupleA)))) + (n/= size (list.size (la.unfold-tuple tupleA)))) _ false))) (test "Can analyse pseudo-product (singleton tuple)" - (|> (&;with-type singletonT + (|> (&.with-type singletonT (analyse (` [(~ singletonC)]))) - (macro;run (init-compiler [])) - (case> (#e;Success singletonA) + (macro.run (init-compiler [])) + (case> (#e.Success singletonA) true - (#e;Error error) + (#e.Error error) false))) (test "Can analyse product through bound type-vars." - (|> (&;with-scope - (do macro;Monad<Meta> - [[_ varT] (&;with-type-env tc;var) - _ (&;with-type-env - (tc;check varT (type;tuple (list/map product;left primitives))))] - (&;with-type varT - (@;analyse-product analyse (list/map product;right primitives))))) - (macro;run (init-compiler [])) - (case> (#e;Success [_ tupleA]) - (n.= size (list;size (la;unfold-tuple tupleA))) + (|> (&.with-scope + (do macro.Monad<Meta> + [[_ varT] (&.with-type-env tc.var) + _ (&.with-type-env + (tc.check varT (type.tuple (list/map product.left primitives))))] + (&.with-type varT + (@.analyse-product analyse (list/map product.right primitives))))) + (macro.run (init-compiler [])) + (case> (#e.Success [_ tupleA]) + (n/= size (list.size (la.unfold-tuple tupleA))) _ false))) (test "Can analyse product through existential quantification." - (|> (&;with-scope - (&;with-type (type;ex-q +1 +tupleT) - (@;analyse-product analyse (list/map product;right +primitives)))) - (macro;run (init-compiler [])) - (case> (#e;Success _) + (|> (&.with-scope + (&.with-type (type.ex-q +1 +tupleT) + (@.analyse-product analyse (list/map product.right +primitives)))) + (macro.run (init-compiler [])) + (case> (#e.Success _) true - (#e;Error error) + (#e.Error error) false))) (test "Cannot analyse product through universal quantification." - (|> (&;with-scope - (&;with-type (type;univ-q +1 +tupleT) - (@;analyse-product analyse (list/map product;right +primitives)))) - (macro;run (init-compiler [])) - (case> (#e;Success _) + (|> (&.with-scope + (&.with-type (type.univ-q +1 +tupleT) + (@.analyse-product analyse (list/map product.right +primitives)))) + (macro.run (init-compiler [])) + (case> (#e.Success _) false - (#e;Error error) + (#e.Error error) true))) )))) (def: (check-variant-inference variantT choice size analysis) - (-> Type Nat Nat (Meta [Module Scope Type la;Analysis]) Bool) + (-> Type Nat Nat (Meta [Module Scope Type la.Analysis]) Bool) (|> analysis - (macro;run (init-compiler [])) - (case> (^multi (#e;Success [_ _ sumT sumA]) - [(la;unfold-variant sumA) - (#;Some [tag last? valueA])]) + (macro.run (init-compiler [])) + (case> (^multi (#e.Success [_ _ sumT sumA]) + [(la.unfold-variant sumA) + (#.Some [tag last? valueA])]) (and (type/= variantT sumT) - (n.= tag choice) - (bool/= last? (n.= (n.dec size) choice))) + (n/= tag choice) + (bool/= last? (n/= (n/dec size) choice))) _ false))) (def: (check-record-inference tupleT size analysis) - (-> Type Nat (Meta [Module Scope Type la;Analysis]) Bool) + (-> Type Nat (Meta [Module Scope Type la.Analysis]) Bool) (|> analysis - (macro;run (init-compiler [])) - (case> (^multi (#e;Success [_ _ productT productA]) - [(la;unfold-tuple productA) + (macro.run (init-compiler [])) + (case> (^multi (#e.Success [_ _ productT productA]) + [(la.unfold-tuple productA) membersA]) (and (type/= tupleT productT) - (n.= size (list;size membersA))) + (n/= size (list.size membersA))) _ false))) @@ -215,64 +215,64 @@ (context: "Tagged Sums" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) - tags (|> (r;set text;Hash<Text> size (r;text +5)) (:: @ map S;to-list)) - choice (|> r;nat (:: @ map (n.% size))) - other-choice (|> r;nat (:: @ map (n.% size)) (r;filter (|>. (n.= choice) not))) - primitives (r;list size gen-primitive) - module-name (r;text +5) - type-name (r;text +5) - #let [varT (#;Bound +1) - primitivesT (list/map product;left primitives) - [choiceT choiceC] (maybe;assume (list;nth choice primitives)) - [other-choiceT other-choiceC] (maybe;assume (list;nth other-choice primitives)) - variantT (type;variant primitivesT) - namedT (#;Named [module-name type-name] variantT) - polyT (|> (type;variant (list;concat (list (list;take choice primitivesT) + [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2)))) + tags (|> (r.set text.Hash<Text> size (r.text +5)) (:: @ map S.to-list)) + choice (|> r.nat (:: @ map (n/% size))) + other-choice (|> r.nat (:: @ map (n/% size)) (r.filter (|>> (n/= choice) not))) + primitives (r.list size gen-primitive) + module-name (r.text +5) + type-name (r.text +5) + #let [varT (#.Bound +1) + primitivesT (list/map product.left primitives) + [choiceT choiceC] (maybe.assume (list.nth choice primitives)) + [other-choiceT other-choiceC] (maybe.assume (list.nth other-choice primitives)) + variantT (type.variant primitivesT) + namedT (#.Named [module-name type-name] variantT) + polyT (|> (type.variant (list.concat (list (list.take choice primitivesT) (list varT) - (list;drop (n.inc choice) primitivesT)))) - (type;univ-q +1)) - named-polyT (#;Named [module-name type-name] polyT) - choice-tag (maybe;assume (list;nth choice tags)) - other-choice-tag (maybe;assume (list;nth other-choice tags))]] + (list.drop (n/inc choice) primitivesT)))) + (type.univ-q +1)) + named-polyT (#.Named [module-name type-name] polyT) + choice-tag (maybe.assume (list.nth choice tags)) + other-choice-tag (maybe.assume (list.nth other-choice tags))]] ($_ seq (test "Can infer tagged sum." - (|> (@module;with-module +0 module-name - (do macro;Monad<Meta> - [_ (@module;declare-tags tags false namedT)] - (&;with-scope - (@common;with-unknown-type - (@;analyse-tagged-sum analyse [module-name choice-tag] choiceC))))) + (|> (@module.with-module +0 module-name + (do macro.Monad<Meta> + [_ (@module.declare-tags tags false namedT)] + (&.with-scope + (@common.with-unknown-type + (@.analyse-tagged-sum analyse [module-name choice-tag] choiceC))))) (check-variant-inference variantT choice size))) (test "Tagged sums specialize when type-vars get bound." - (|> (@module;with-module +0 module-name - (do macro;Monad<Meta> - [_ (@module;declare-tags tags false named-polyT)] - (&;with-scope - (@common;with-unknown-type - (@;analyse-tagged-sum analyse [module-name choice-tag] choiceC))))) + (|> (@module.with-module +0 module-name + (do macro.Monad<Meta> + [_ (@module.declare-tags tags false named-polyT)] + (&.with-scope + (@common.with-unknown-type + (@.analyse-tagged-sum analyse [module-name choice-tag] choiceC))))) (check-variant-inference variantT choice size))) (test "Tagged sum inference retains universal quantification when type-vars are not bound." - (|> (@module;with-module +0 module-name - (do macro;Monad<Meta> - [_ (@module;declare-tags tags false named-polyT)] - (&;with-scope - (@common;with-unknown-type - (@;analyse-tagged-sum analyse [module-name other-choice-tag] other-choiceC))))) + (|> (@module.with-module +0 module-name + (do macro.Monad<Meta> + [_ (@module.declare-tags tags false named-polyT)] + (&.with-scope + (@common.with-unknown-type + (@.analyse-tagged-sum analyse [module-name other-choice-tag] other-choiceC))))) (check-variant-inference polyT other-choice size))) (test "Can specialize generic tagged sums." - (|> (@module;with-module +0 module-name - (do macro;Monad<Meta> - [_ (@module;declare-tags tags false named-polyT)] - (&;with-scope - (&;with-type variantT - (@;analyse-tagged-sum analyse [module-name other-choice-tag] other-choiceC))))) - (macro;run (init-compiler [])) - (case> (^multi (#e;Success [_ _ sumA]) - [(la;unfold-variant sumA) - (#;Some [tag last? valueA])]) - (and (n.= tag other-choice) - (bool/= last? (n.= (n.dec size) other-choice))) + (|> (@module.with-module +0 module-name + (do macro.Monad<Meta> + [_ (@module.declare-tags tags false named-polyT)] + (&.with-scope + (&.with-type variantT + (@.analyse-tagged-sum analyse [module-name other-choice-tag] other-choiceC))))) + (macro.run (init-compiler [])) + (case> (^multi (#e.Success [_ _ sumA]) + [(la.unfold-variant sumA) + (#.Some [tag last? valueA])]) + (and (n/= tag other-choice) + (bool/= last? (n/= (n/dec size) other-choice))) _ false))) @@ -281,53 +281,53 @@ (context: "Records" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) - tags (|> (r;set text;Hash<Text> size (r;text +5)) (:: @ map S;to-list)) - primitives (r;list size gen-primitive) - module-name (r;text +5) - type-name (r;text +5) - choice (|> r;nat (:: @ map (n.% size))) - #let [varT (#;Bound +1) - tagsC (list/map (|>. [module-name] code;tag) tags) - primitivesT (list/map product;left primitives) - primitivesC (list/map product;right primitives) - tupleT (type;tuple primitivesT) - namedT (#;Named [module-name type-name] tupleT) - recordC (list;zip2 tagsC primitivesC) - polyT (|> (type;tuple (list;concat (list (list;take choice primitivesT) + [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2)))) + tags (|> (r.set text.Hash<Text> size (r.text +5)) (:: @ map S.to-list)) + primitives (r.list size gen-primitive) + module-name (r.text +5) + type-name (r.text +5) + choice (|> r.nat (:: @ map (n/% size))) + #let [varT (#.Bound +1) + tagsC (list/map (|>> [module-name] code.tag) tags) + primitivesT (list/map product.left primitives) + primitivesC (list/map product.right primitives) + tupleT (type.tuple primitivesT) + namedT (#.Named [module-name type-name] tupleT) + recordC (list.zip2 tagsC primitivesC) + polyT (|> (type.tuple (list.concat (list (list.take choice primitivesT) (list varT) - (list;drop (n.inc choice) primitivesT)))) - (type;univ-q +1)) - named-polyT (#;Named [module-name type-name] polyT)]] + (list.drop (n/inc choice) primitivesT)))) + (type.univ-q +1)) + named-polyT (#.Named [module-name type-name] polyT)]] ($_ seq (test "Can infer record." - (|> (@module;with-module +0 module-name - (do macro;Monad<Meta> - [_ (@module;declare-tags tags false namedT)] - (&;with-scope - (@common;with-unknown-type - (@;analyse-record analyse recordC))))) + (|> (@module.with-module +0 module-name + (do macro.Monad<Meta> + [_ (@module.declare-tags tags false namedT)] + (&.with-scope + (@common.with-unknown-type + (@.analyse-record analyse recordC))))) (check-record-inference tupleT size))) (test "Records specialize when type-vars get bound." - (|> (@module;with-module +0 module-name - (do macro;Monad<Meta> - [_ (@module;declare-tags tags false named-polyT)] - (&;with-scope - (@common;with-unknown-type - (@;analyse-record analyse recordC))))) + (|> (@module.with-module +0 module-name + (do macro.Monad<Meta> + [_ (@module.declare-tags tags false named-polyT)] + (&.with-scope + (@common.with-unknown-type + (@.analyse-record analyse recordC))))) (check-record-inference tupleT size))) (test "Can specialize generic records." - (|> (@module;with-module +0 module-name - (do macro;Monad<Meta> - [_ (@module;declare-tags tags false named-polyT)] - (&;with-scope - (&;with-type tupleT - (@;analyse-record analyse recordC))))) - (macro;run (init-compiler [])) - (case> (^multi (#e;Success [_ _ productA]) - [(la;unfold-tuple productA) + (|> (@module.with-module +0 module-name + (do macro.Monad<Meta> + [_ (@module.declare-tags tags false named-polyT)] + (&.with-scope + (&.with-type tupleT + (@.analyse-record analyse recordC))))) + (macro.run (init-compiler [])) + (case> (^multi (#e.Success [_ _ productA]) + [(la.unfold-tuple productA) membersA]) - (n.= size (list;size membersA)) + (n/= size (list.size membersA)) _ false))) diff --git a/new-luxc/test/test/luxc/lang/analysis/type.lux b/new-luxc/test/test/luxc/lang/analysis/type.lux index b159870c8..6f8a1343a 100644 --- a/new-luxc/test/test/luxc/lang/analysis/type.lux +++ b/new-luxc/test/test/luxc/lang/analysis/type.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -17,33 +17,33 @@ (lang [type "type/" Eq<Type>]) test) (luxc ["&" lang] - (lang ["&;" module] + (lang ["&." module] ["~" analysis] - (analysis [";A" expression] + (analysis [".A" expression] ["@" type] - ["@;" common]) - (translation ["@;" runtime]) + ["@." common]) + (translation ["@." runtime]) [eval])) - (.. common) + (// common) (test/luxc common)) (def: check - (r;Random [Code Type Code]) + (r.Random [Code Type Code]) (with-expansions [<triples> (do-template [<random> <type> <code>] - [(do r;Monad<Random> + [(do r.Monad<Random> [value <random>] (wrap [(` <type>) <type> (<code> value)]))] - [r;bool (+0 "#Bool" (+0)) code;bool] - [r;nat (+0 "#Nat" (+0)) code;nat] - [r;int (+0 "#Int" (+0)) code;int] - [r;deg (+0 "#Deg" (+0)) code;deg] - [r;frac (+0 "#Frac" (+0)) code;frac] - [(r;text +5) (+0 "#Text" (+0)) code;text] + [r.bool (+0 "#Bool" (+0)) code.bool] + [r.nat (+0 "#Nat" (+0)) code.nat] + [r.int (+0 "#Int" (+0)) code.int] + [r.deg (+0 "#Deg" (+0)) code.deg] + [r.frac (+0 "#Frac" (+0)) code.frac] + [(r.text +5) (+0 "#Text" (+0)) code.text] )] - ($_ r;either + ($_ r.either <triples>))) (context: "Type checking/coercion." @@ -53,39 +53,39 @@ ($_ seq (test (format "Can analyse type-checking.") (|> (do Monad<Meta> - [runtime-bytecode @runtime;translate] - (&;with-scope - (@common;with-unknown-type - (@;analyse-check analyse eval;eval typeC exprC)))) - (macro;run (init-compiler [])) - (case> (#e;Success [_ [analysisT analysisA]]) + [runtime-bytecode @runtime.translate] + (&.with-scope + (@common.with-unknown-type + (@.analyse-check analyse eval.eval typeC exprC)))) + (macro.run (init-compiler [])) + (case> (#e.Success [_ [analysisT analysisA]]) (and (type/= codeT analysisT) (case [exprC analysisA] (^template [<tag> <test>] [[_ (<tag> expected)] [_ (<tag> actual)]] (<test> expected actual)) - ([#;Bool bool/=] - [#;Nat n.=] - [#;Int i.=] - [#;Deg d.=] - [#;Frac f.=] - [#;Text text/=]) + ([#.Bool bool/=] + [#.Nat n/=] + [#.Int i/=] + [#.Deg d/=] + [#.Frac f/=] + [#.Text text/=]) _ false)) - (#e;Error error) + (#e.Error error) false))) (test (format "Can analyse type-coercion.") (|> (do Monad<Meta> - [runtime-bytecode @runtime;translate] - (&;with-scope - (@common;with-unknown-type - (@;analyse-coerce analyse eval;eval typeC exprC)))) - (macro;run (init-compiler [])) - (case> (#e;Success [_ [analysisT analysisA]]) + [runtime-bytecode @runtime.translate] + (&.with-scope + (@common.with-unknown-type + (@.analyse-coerce analyse eval.eval typeC exprC)))) + (macro.run (init-compiler [])) + (case> (#e.Success [_ [analysisT analysisA]]) (type/= codeT analysisT) - (#e;Error error) + (#e.Error error) false))) )))) diff --git a/new-luxc/test/test/luxc/lang/synthesis/case/special.lux b/new-luxc/test/test/luxc/lang/synthesis/case/special.lux index 1ae6ad030..4e00163ae 100644 --- a/new-luxc/test/test/luxc/lang/synthesis/case/special.lux +++ b/new-luxc/test/test/luxc/lang/synthesis/case/special.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -8,35 +8,35 @@ test) (luxc (lang ["la" analysis] ["ls" synthesis] - (synthesis [";S" expression]) - [";L" variable #+ Variable])) - (../.. common)) + (synthesis [".S" expression]) + [".L" variable #+ Variable])) + (/// common)) (context: "Dummy variables." (<| (times +100) (do @ [maskedA gen-primitive - temp (|> r;nat (:: @ map (n.% +100))) + temp (|> r.nat (:: @ map (n/% +100))) #let [maskA (` ("lux case" (~ maskedA) - {("lux case bind" (~ (code;nat temp))) - (~ (la;var (variableL;local temp)))}))]] + {("lux case bind" (~ (code.nat temp))) + (~ (la.var (variableL.local temp)))}))]] (test "Dummy variables created to mask expressions get eliminated during synthesis." - (|> (expressionS;synthesize maskA) + (|> (expressionS.synthesize maskA) (corresponds? maskedA)))))) (context: "Let expressions." (<| (times +100) (do @ - [registerA r;nat + [registerA r.nat inputA gen-primitive outputA gen-primitive #let [letA (` ("lux case" (~ inputA) - {("lux case bind" (~ (code;nat registerA))) + {("lux case bind" (~ (code.nat registerA))) (~ outputA)}))]] (test "Can detect and reify simple 'let' expressions." - (|> (expressionS;synthesize letA) - (case> (^ [_ (#;Form (list [_ (#;Text "lux let")] [_ (#;Nat registerS)] inputS outputS))]) - (and (n.= registerA registerS) + (|> (expressionS.synthesize letA) + (case> (^ [_ (#.Form (list [_ (#.Text "lux let")] [_ (#.Nat registerS)] inputS outputS))]) + (and (n/= registerA registerS) (corresponds? inputA inputS) (corresponds? outputA outputS)) @@ -46,7 +46,7 @@ (context: "If expressions." (<| (times +100) (do @ - [then|else r;bool + [then|else r.bool inputA gen-primitive thenA gen-primitive elseA gen-primitive @@ -58,8 +58,8 @@ {false (~ elseA) true (~ thenA)})))]] (test "Can detect and reify simple 'if' expressions." - (|> (expressionS;synthesize ifA) - (case> (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))]) + (|> (expressionS.synthesize ifA) + (case> (^ [_ (#.Form (list [_ (#.Text "lux if")] inputS thenS elseS))]) (and (corresponds? inputA inputS) (corresponds? thenA thenS) (corresponds? elseA elseS)) diff --git a/new-luxc/test/test/luxc/lang/synthesis/common.lux b/new-luxc/test/test/luxc/lang/synthesis/common.lux index caa2d09dc..3379fe7fd 100644 --- a/new-luxc/test/test/luxc/lang/synthesis/common.lux +++ b/new-luxc/test/test/luxc/lang/synthesis/common.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (data [bool "bool/" Eq<Bool>] [text "text/" Eq<Text>]) @@ -8,17 +8,17 @@ ["ls" synthesis]))) (def: #export gen-primitive - (r;Random la;Analysis) - (r;either (r;either (r;either (r/wrap (' [])) - (r/map code;bool r;bool)) - (r;either (r/map code;nat r;nat) - (r/map code;int r;int))) - (r;either (r;either (r/map code;deg r;deg) - (r/map code;frac r;frac)) - (r/map code;text (r;text +5))))) + (r.Random la.Analysis) + (r.either (r.either (r.either (r/wrap (' [])) + (r/map code.bool r.bool)) + (r.either (r/map code.nat r.nat) + (r/map code.int r.int))) + (r.either (r.either (r/map code.deg r.deg) + (r/map code.frac r.frac)) + (r/map code.text (r.text +5))))) (def: #export (corresponds? analysis synthesis) - (-> la;Analysis ls;Synthesis Bool) + (-> la.Analysis ls.Synthesis Bool) (case [analysis synthesis] (^ [(^code []) (^code [])]) true @@ -26,12 +26,12 @@ (^template [<tag> <test>] [[_ (<tag> valueA)] [_ (<tag> valueS)]] (<test> valueA valueS)) - ([#;Bool bool/=] - [#;Nat n.=] - [#;Int i.=] - [#;Deg d.=] - [#;Frac f.=] - [#;Text text/=]) + ([#.Bool bool/=] + [#.Nat n/=] + [#.Int i/=] + [#.Deg d/=] + [#.Frac f/=] + [#.Text text/=]) _ false)) diff --git a/new-luxc/test/test/luxc/lang/synthesis/function.lux b/new-luxc/test/test/luxc/lang/synthesis/function.lux index 259bf5a4e..eaae351f0 100644 --- a/new-luxc/test/test/luxc/lang/synthesis/function.lux +++ b/new-luxc/test/test/luxc/lang/synthesis/function.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -15,20 +15,20 @@ test) (luxc (lang ["la" analysis] ["ls" synthesis] - (synthesis [";S" expression]) - [";L" variable #+ Variable])) - (.. common)) + (synthesis [".S" expression]) + [".L" variable #+ Variable])) + (// common)) (def: gen-function//constant - (r;Random [Nat la;Analysis la;Analysis]) - (r;rec + (r.Random [Nat la.Analysis la.Analysis]) + (r.rec (function [gen-function//constant] - (do r;Monad<Random> - [function? r;bool] + (do r.Monad<Random> + [function? r.bool] (if function? (do @ [[num-args outputA subA] gen-function//constant] - (wrap [(n.inc num-args) + (wrap [(n/inc num-args) outputA (` ("lux function" [] (~ subA)))])) (do @ @@ -36,62 +36,62 @@ (wrap [+0 outputA outputA]))))))) (def: (pick scope-size) - (-> Nat (r;Random Nat)) - (|> r;nat (:: r;Monad<Random> map (n.% 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 (list/map variableL;local indices) - relative-env (list/map variableL;captured indices)] - [total-args prediction bodyA] (: (r;Random [Nat Int la;Analysis]) + (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 (list/map variableL.local indices) + relative-env (list/map variableL.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) + (let [env-size (list.size global-env) resolver (list/fold (function [[idx var] resolver] - (dict;put idx var resolver)) + (dict.put idx var resolver)) (: (Dict Nat Int) - (dict;new number;Hash<Nat>)) - (list;zip2 (list;n.range +0 (n.dec env-size)) + (dict.new number.Hash<Nat>)) + (list.zip2 (list.n/range +0 (n/dec env-size)) global-env))] (do @ - [nest? r;bool] + [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 set;to-list)) - [total-args prediction bodyA] (recur (n.inc num-args) - (list/map (function [pick] (maybe;assume (list;nth pick global-env))) + [num-picks (:: @ map (n/max +1) (pick (n/inc env-size))) + picks (|> (r.set number.Hash<Nat> num-picks (pick env-size)) + (:: @ map set.to-list)) + [total-args prediction bodyA] (recur (n/inc num-args) + (list/map (function [pick] (maybe.assume (list.nth pick global-env))) picks))] - (wrap [total-args prediction (` ("lux function" [(~@ (list/map (|>. variableL;captured code;int) picks))] + (wrap [total-args prediction (` ("lux function" [(~@ (list/map (|>> variableL.captured code.int) picks))] (~ bodyA)))])) (do @ - [chosen (pick (list;size global-env))] + [chosen (pick (list.size global-env))] (wrap [num-args - (maybe;assume (dict;get chosen resolver)) - (la;var (variableL;captured chosen))])))))))] + (maybe.assume (dict.get chosen resolver)) + (la.var (variableL.captured chosen))])))))))] (wrap [total-args prediction (` ("lux function" - [(~@ (list/map code;int absolute-env))] + [(~@ (list/map code.int absolute-env))] (~ bodyA)))]) )) (def: gen-function//local - (r;Random [Nat Int la;Analysis]) + (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?')] + (do r.Monad<Random> + [nest?' r.bool + [total-args prediction bodyA] (recur (n/inc num-args) nest?')] (wrap [total-args prediction (` ("lux function" [] (~ bodyA)))])) - (do r;Monad<Random> - [chosen (|> r;nat (:: @ map (|>. (n.% +100) (n.max +2))))] + (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;var (variableL;local chosen))]))))) + (|> chosen (n/+ (n/dec num-args)) nat-to-int) + (la.var (variableL.local chosen))]))))) (context: "Function definition." (<| (times +100) @@ -101,28 +101,28 @@ [args3 prediction3 function3] gen-function//local] ($_ seq (test "Nested functions will get folded together." - (|> (expressionS;synthesize function1) - (case> (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat args)] [_ (#;Tuple captured)] output))]) - (and (n.= args1 args) + (|> (expressionS.synthesize function1) + (case> (^ [_ (#.Form (list [_ (#.Text "lux function")] [_ (#.Nat args)] [_ (#.Tuple captured)] output))]) + (and (n/= args1 args) (corresponds? prediction1 output)) _ - (n.= +0 args1)))) + (n/= +0 args1)))) (test "Folded functions provide direct access to captured variables." - (|> (expressionS;synthesize function2) - (case> (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat args)] [_ (#;Tuple captured)] - [_ (#;Form (list [_ (#;Int output)]))]))]) - (and (n.= args2 args) - (i.= prediction2 output)) + (|> (expressionS.synthesize function2) + (case> (^ [_ (#.Form (list [_ (#.Text "lux function")] [_ (#.Nat args)] [_ (#.Tuple captured)] + [_ (#.Form (list [_ (#.Int output)]))]))]) + (and (n/= args2 args) + (i/= prediction2 output)) _ false))) (test "Folded functions properly offset local variables." - (|> (expressionS;synthesize function3) - (case> (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat args)] [_ (#;Tuple captured)] - [_ (#;Form (list [_ (#;Int output)]))]))]) - (and (n.= args3 args) - (i.= prediction3 output)) + (|> (expressionS.synthesize function3) + (case> (^ [_ (#.Form (list [_ (#.Text "lux function")] [_ (#.Nat args)] [_ (#.Tuple captured)] + [_ (#.Form (list [_ (#.Int output)]))]))]) + (and (n/= args3 args) + (i/= prediction3 output)) _ false))) @@ -131,20 +131,20 @@ (context: "Function application." (<| (times +100) (do @ - [num-args (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1)))) + [num-args (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1)))) funcA gen-primitive - argsA (r;list num-args gen-primitive)] + argsA (r.list num-args gen-primitive)] ($_ seq (test "Can synthesize function application." - (|> (expressionS;synthesize (la;apply argsA funcA)) - (case> (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))]) + (|> (expressionS.synthesize (la.apply argsA funcA)) + (case> (^ [_ (#.Form (list& [_ (#.Text "lux call")] funcS argsS))]) (and (corresponds? funcA funcS) - (list;every? (product;uncurry corresponds?) - (list;zip2 argsA argsS))) + (list.every? (product.uncurry corresponds?) + (list.zip2 argsA argsS))) _ false))) (test "Function application on no arguments just synthesizes to the function itself." - (|> (expressionS;synthesize (la;apply (list) funcA)) + (|> (expressionS.synthesize (la.apply (list) funcA)) (corresponds? funcA))) )))) diff --git a/new-luxc/test/test/luxc/lang/synthesis/loop.lux b/new-luxc/test/test/luxc/lang/synthesis/loop.lux index 386b06dcd..805c66190 100644 --- a/new-luxc/test/test/luxc/lang/synthesis/loop.lux +++ b/new-luxc/test/test/luxc/lang/synthesis/loop.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do]) @@ -12,37 +12,37 @@ test) (luxc (lang ["la" analysis] ["ls" synthesis] - (synthesis [";S" expression] - [";S" loop]))) - (.. common)) + (synthesis [".S" expression] + [".S" loop]))) + (// common)) (def: (does-recursion? arity exprS) - (-> ls;Arity ls;Synthesis Bool) + (-> ls.Arity ls.Synthesis Bool) (loop [exprS exprS] (case exprS - (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))]) + (^ [_ (#.Form (list [_ (#.Text "lux case")] inputS pathS))]) (loop [pathS pathS] (case pathS - (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))]) + (^ [_ (#.Form (list [_ (#.Text "lux case alt")] leftS rightS))]) (or (recur leftS) (recur rightS)) - (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))]) + (^ [_ (#.Form (list [_ (#.Text "lux case seq")] leftS rightS))]) (recur rightS) - (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))]) + (^ [_ (#.Form (list [_ (#.Text "lux case exec")] bodyS))]) (does-recursion? arity bodyS) _ false)) - (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))]) - (n.= arity (list;size argsS)) + (^ [_ (#.Form (list& [_ (#.Text "lux recur")] argsS))]) + (n/= arity (list.size argsS)) - (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))]) + (^ [_ (#.Form (list [_ (#.Text "lux let")] register inputS bodyS))]) (recur bodyS) - (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))]) + (^ [_ (#.Form (list [_ (#.Text "lux if")] inputS thenS elseS))]) (or (recur thenS) (recur elseS)) @@ -51,73 +51,73 @@ ))) (def: (gen-body arity output) - (-> Nat la;Analysis (r;Random la;Analysis)) - (r;either (r;either (r/wrap output) - (do r;Monad<Random> - [inputA (|> r;nat (:: @ map code;nat)) - num-cases (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1)))) - tests (|> (r;set number;Hash<Nat> num-cases r;nat) - (:: @ map (|>. s;to-list (list/map code;nat)))) - #let [bad-bodies (list;repeat num-cases (' []))] + (-> Nat la.Analysis (r.Random la.Analysis)) + (r.either (r.either (r/wrap output) + (do r.Monad<Random> + [inputA (|> r.nat (:: @ map code.nat)) + num-cases (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1)))) + tests (|> (r.set number.Hash<Nat> num-cases r.nat) + (:: @ map (|>> s.to-list (list/map code.nat)))) + #let [bad-bodies (list.repeat num-cases (' []))] good-body (gen-body arity output) - where-to-set (|> r;nat (:: @ map (n.% num-cases))) - #let [bodies (list;concat (list (list;take where-to-set bad-bodies) + where-to-set (|> r.nat (:: @ map (n/% num-cases))) + #let [bodies (list.concat (list (list.take where-to-set bad-bodies) (list good-body) - (list;drop (n.inc where-to-set) bad-bodies)))]] + (list.drop (n/inc where-to-set) bad-bodies)))]] (wrap (` ("lux case" (~ inputA) - (~ (code;record (list;zip2 tests bodies)))))))) - (r;either (do r;Monad<Random> - [valueS r;bool - output' (gen-body (n.inc arity) output)] - (wrap (` ("lux case" (~ (code;bool valueS)) - {("lux case bind" (~ (code;nat arity))) (~ output')})))) - (do r;Monad<Random> - [valueS r;bool - then|else r;bool + (~ (code.record (list.zip2 tests bodies)))))))) + (r.either (do r.Monad<Random> + [valueS r.bool + output' (gen-body (n/inc arity) output)] + (wrap (` ("lux case" (~ (code.bool valueS)) + {("lux case bind" (~ (code.nat arity))) (~ output')})))) + (do r.Monad<Random> + [valueS r.bool + then|else r.bool output' (gen-body arity output) #let [thenA (if then|else output' (' [])) elseA (if (not then|else) output' (' []))]] - (wrap (` ("lux case" (~ (code;bool valueS)) - {(~ (code;bool then|else)) (~ thenA) - (~ (code;bool (not then|else))) (~ elseA)}))))) + (wrap (` ("lux case" (~ (code.bool valueS)) + {(~ (code.bool then|else)) (~ thenA) + (~ (code.bool (not then|else))) (~ elseA)}))))) )) (def: (make-function arity body) - (-> ls;Arity la;Analysis la;Analysis) + (-> ls.Arity la.Analysis la.Analysis) (case arity +0 body - _ (` ("lux function" [] (~ (make-function (n.dec arity) body)))))) + _ (` ("lux function" [] (~ (make-function (n/dec arity) body)))))) (def: gen-recursion - (r;Random [Bool Nat la;Analysis]) - (do r;Monad<Random> - [arity (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1)))) - recur? r;bool + (r.Random [Bool Nat la.Analysis]) + (do r.Monad<Random> + [arity (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1)))) + recur? r.bool outputS (if recur? - (wrap (la;apply (list;repeat arity (' [])) (la;var 0))) + (wrap (la.apply (list.repeat arity (' [])) (la.var 0))) (do @ - [plus-or-minus? r;bool - how-much (|> r;nat (:: @ map (|>. (n.% arity) (n.max +1)))) - #let [shift (if plus-or-minus? n.+ n.-)]] - (wrap (la;apply (list;repeat (shift how-much arity) (' [])) (la;var 0))))) + [plus-or-minus? r.bool + how-much (|> r.nat (:: @ map (|>> (n/% arity) (n/max +1)))) + #let [shift (if plus-or-minus? n/+ n/-)]] + (wrap (la.apply (list.repeat (shift how-much arity) (' [])) (la.var 0))))) bodyS (gen-body arity outputS)] (wrap [recur? arity (make-function arity bodyS)]))) (def: gen-loop - (r;Random [Bool Nat la;Analysis]) - (do r;Monad<Random> - [arity (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1)))) - recur? r;bool - self-ref? r;bool - #let [selfA (la;var 0) + (r.Random [Bool Nat la.Analysis]) + (do r.Monad<Random> + [arity (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1)))) + recur? r.bool + self-ref? r.bool + #let [selfA (la.var 0) argA (if self-ref? selfA (' []))] outputS (if recur? - (wrap (la;apply (list;repeat arity argA) selfA)) + (wrap (la.apply (list.repeat arity argA) selfA)) (do @ - [plus-or-minus? r;bool - how-much (|> r;nat (:: @ map (|>. (n.% arity) (n.max +1)))) - #let [shift (if plus-or-minus? n.+ n.-)]] - (wrap (la;apply (list;repeat (shift how-much arity) (' [])) selfA)))) + [plus-or-minus? r.bool + how-much (|> r.nat (:: @ map (|>> (n/% arity) (n/max +1)))) + #let [shift (if plus-or-minus? n/+ n/-)]] + (wrap (la.apply (list.repeat (shift how-much arity) (' [])) selfA)))) bodyS (gen-body arity outputS)] (wrap [(and recur? (not self-ref?)) arity @@ -129,12 +129,12 @@ [[prediction arity analysis] gen-recursion] ($_ seq (test "Can accurately identify (and then reify) tail recursion." - (case (expressionS;synthesize analysis) - (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat _arity)] [_ (#;Tuple _env)] _body))]) + (case (expressionS.synthesize analysis) + (^ [_ (#.Form (list [_ (#.Text "lux function")] [_ (#.Nat _arity)] [_ (#.Tuple _env)] _body))]) (|> _body (does-recursion? arity) (bool/= prediction) - (and (n.= arity _arity))) + (and (n/= arity _arity))) _ false)))))) @@ -145,15 +145,15 @@ [[prediction arity analysis] gen-recursion] ($_ seq (test "Can reify loops." - (case (expressionS;synthesize (la;apply (list;repeat arity (' [])) analysis)) - (^ [_ (#;Form (list [_ (#;Text "lux loop")] [_ (#;Nat in_register)] [_ (#;Tuple _inits)] _body))]) - (and (n.= arity (list;size _inits)) - (not (loopS;contains-self-reference? _body))) + (case (expressionS.synthesize (la.apply (list.repeat arity (' [])) analysis)) + (^ [_ (#.Form (list [_ (#.Text "lux loop")] [_ (#.Nat in_register)] [_ (#.Tuple _inits)] _body))]) + (and (n/= arity (list.size _inits)) + (not (loopS.contains-self-reference? _body))) - (^ [_ (#;Form (list& [_ (#;Text "lux call")] - [_ (#;Form (list [_ (#;Text "lux function")] _arity _env _bodyS))] + (^ [_ (#.Form (list& [_ (#.Text "lux call")] + [_ (#.Form (list [_ (#.Text "lux function")] _arity _env _bodyS))] argsS))]) - (loopS;contains-self-reference? _bodyS) + (loopS.contains-self-reference? _bodyS) _ false)))))) diff --git a/new-luxc/test/test/luxc/lang/synthesis/primitive.lux b/new-luxc/test/test/luxc/lang/synthesis/primitive.lux index 47f394117..157a9c1c3 100644 --- a/new-luxc/test/test/luxc/lang/synthesis/primitive.lux +++ b/new-luxc/test/test/luxc/lang/synthesis/primitive.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -9,20 +9,20 @@ test) (luxc (lang ["la" analysis] ["ls" synthesis] - (synthesis [";S" expression])))) + (synthesis [".S" expression])))) (context: "Primitives" (<| (times +100) (do @ - [%bool% r;bool - %nat% r;nat - %int% r;int - %deg% r;deg - %frac% r;frac - %text% (r;text +5)] + [%bool% r.bool + %nat% r.nat + %int% r.int + %deg% r.deg + %frac% r.frac + %text% (r.text +5)] (`` ($_ seq (test (format "Can synthesize unit.") - (|> (expressionS;synthesize (' [])) + (|> (expressionS.synthesize (' [])) (case> (^code []) true @@ -30,16 +30,16 @@ false))) (~~ (do-template [<desc> <analysis> <synthesis> <sample>] [(test (format "Can synthesize " <desc> ".") - (|> (expressionS;synthesize (<analysis> <sample>)) + (|> (expressionS.synthesize (<analysis> <sample>)) (case> [_ (<synthesis> value)] (is <sample> value) _ false)))] - ["bool" code;bool #;Bool %bool%] - ["nat" code;nat #;Nat %nat%] - ["int" code;int #;Int %int%] - ["deg" code;deg #;Deg %deg%] - ["frac" code;frac #;Frac %frac%] - ["text" code;text #;Text %text%]))))))) + ["bool" code.bool #.Bool %bool%] + ["nat" code.nat #.Nat %nat%] + ["int" code.int #.Int %int%] + ["deg" code.deg #.Deg %deg%] + ["frac" code.frac #.Frac %frac%] + ["text" code.text #.Text %text%]))))))) diff --git a/new-luxc/test/test/luxc/lang/synthesis/procedure.lux b/new-luxc/test/test/luxc/lang/synthesis/procedure.lux index 2263a1616..7b8923248 100644 --- a/new-luxc/test/test/luxc/lang/synthesis/procedure.lux +++ b/new-luxc/test/test/luxc/lang/synthesis/procedure.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -10,22 +10,22 @@ test) (luxc (lang ["la" analysis] ["ls" synthesis] - (synthesis [";S" expression]))) - (.. common)) + (synthesis [".S" expression]))) + (// common)) (context: "Procedures" (<| (times +100) (do @ - [num-args (|> r;nat (:: @ map (n.% +10))) - nameA (r;text +5) - argsA (r;list num-args gen-primitive)] + [num-args (|> r.nat (:: @ map (n/% +10))) + nameA (r.text +5) + argsA (r.list num-args gen-primitive)] ($_ seq (test "Can synthesize procedure calls." - (|> (expressionS;synthesize (la;procedure nameA argsA)) - (case> (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))]) + (|> (expressionS.synthesize (la.procedure nameA argsA)) + (case> (^ [_ (#.Form (list& [_ (#.Text procedure)] argsS))]) (and (text/= nameA procedure) - (list;every? (product;uncurry corresponds?) - (list;zip2 argsA argsS))) + (list.every? (product.uncurry corresponds?) + (list.zip2 argsA argsS))) _ false))) diff --git a/new-luxc/test/test/luxc/lang/synthesis/structure.lux b/new-luxc/test/test/luxc/lang/synthesis/structure.lux index eab568bbe..e401149ec 100644 --- a/new-luxc/test/test/luxc/lang/synthesis/structure.lux +++ b/new-luxc/test/test/luxc/lang/synthesis/structure.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -10,21 +10,21 @@ test) (luxc (lang ["la" analysis] ["ls" synthesis] - (synthesis [";S" expression]))) - (.. common)) + (synthesis [".S" expression]))) + (// common)) (context: "Variants" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) - tagA (|> r;nat (:: @ map (n.% size))) + [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2)))) + tagA (|> r.nat (:: @ map (n/% size))) memberA gen-primitive] ($_ seq (test "Can synthesize variants." - (|> (expressionS;synthesize (la;sum tagA size +0 memberA)) - (case> (^ [_ (#;Form (list [_ (#;Nat tagS)] [_ (#;Bool last?S)] memberS))]) - (and (n.= tagA tagS) - (B/= (n.= (n.dec size) tagA) + (|> (expressionS.synthesize (la.sum tagA size +0 memberA)) + (case> (^ [_ (#.Form (list [_ (#.Nat tagS)] [_ (#.Bool last?S)] memberS))]) + (and (n/= tagA tagS) + (B/= (n/= (n/dec size) tagA) last?S) (corresponds? memberA memberS)) @@ -35,14 +35,14 @@ (context: "Tuples" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) - membersA (r;list size gen-primitive)] + [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2)))) + membersA (r.list size gen-primitive)] ($_ seq (test "Can synthesize tuple." - (|> (expressionS;synthesize (la;product membersA)) - (case> [_ (#;Tuple membersS)] - (and (n.= size (list;size membersS)) - (list;every? (product;uncurry corresponds?) (list;zip2 membersA membersS))) + (|> (expressionS.synthesize (la.product membersA)) + (case> [_ (#.Tuple membersS)] + (and (n/= size (list.size membersS)) + (list.every? (product.uncurry corresponds?) (list.zip2 membersA membersS))) _ false))) diff --git a/new-luxc/test/test/luxc/lang/translation/case.lux b/new-luxc/test/test/luxc/lang/translation/case.lux index d843e6e1c..9921a2797 100644 --- a/new-luxc/test/test/luxc/lang/translation/case.lux +++ b/new-luxc/test/test/luxc/lang/translation/case.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -12,53 +12,53 @@ test) (luxc (lang ["ls" synthesis] (translation ["@" case] - [";T" expression] - ["@;" eval] - ["@;" runtime] - ["@;" common]))) + [".T" expression] + ["@." eval] + ["@." runtime] + ["@." common]))) (test/luxc common)) (def: struct-limit Nat +10) (def: (tail? size idx) (-> Nat Nat Bool) - (n.= (n.dec size) idx)) + (n/= (n/dec size) idx)) (def: gen-case - (r;Random [ls;Synthesis ls;Path]) - (<| r;rec (function [gen-case]) - (`` ($_ r;either + (r.Random [ls.Synthesis ls.Path]) + (<| r.rec (function [gen-case]) + (`` ($_ r.either (r/wrap [(' []) (' ("lux case pop"))]) (~~ (do-template [<gen> <synth>] - [(do r;Monad<Random> + [(do r.Monad<Random> [value <gen>] (wrap [(<synth> value) (<synth> value)]))] - [r;bool code;bool] - [r;nat code;nat] - [r;int code;int] - [r;deg code;deg] - [r;frac code;frac] - [(r;text +5) code;text])) - (do r;Monad<Random> - [size (|> r;nat (:: @ map (|>. (n.% struct-limit) (n.max +2)))) - idx (|> r;nat (:: @ map (n.% size))) + [r.bool code.bool] + [r.nat code.nat] + [r.int code.int] + [r.deg code.deg] + [r.frac code.frac] + [(r.text +5) code.text])) + (do r.Monad<Random> + [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2)))) + idx (|> r.nat (:: @ map (n/% size))) [subS subP] gen-case - #let [caseS (` [(~@ (list;concat (list (list;repeat idx (' [])) + #let [caseS (` [(~@ (list.concat (list (list.repeat idx (' [])) (list subS) - (list;repeat (|> size n.dec (n.- idx)) (' [])))))]) + (list.repeat (|> size n/dec (n/- idx)) (' [])))))]) caseP (if (tail? size idx) - (` ("lux case tuple right" (~ (code;nat idx)) (~ subP))) - (` ("lux case tuple left" (~ (code;nat idx)) (~ subP))))]] + (` ("lux case tuple right" (~ (code.nat idx)) (~ subP))) + (` ("lux case tuple left" (~ (code.nat idx)) (~ subP))))]] (wrap [caseS caseP])) - (do r;Monad<Random> - [size (|> r;nat (:: @ map (|>. (n.% struct-limit) (n.max +2)))) - idx (|> r;nat (:: @ map (n.% size))) + (do r.Monad<Random> + [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2)))) + idx (|> r.nat (:: @ map (n/% size))) [subS subP] gen-case - #let [caseS (` ((~ (code;nat idx)) (~ (code;bool (tail? size idx))) (~ subS))) + #let [caseS (` ((~ (code.nat idx)) (~ (code.bool (tail? size idx))) (~ subS))) caseP (if (tail? size idx) - (` ("lux case variant right" (~ (code;nat idx)) (~ subP))) - (` ("lux case variant left" (~ (code;nat idx)) (~ subP))))]] + (` ("lux case variant right" (~ (code.nat idx)) (~ subP))) + (` ("lux case variant left" (~ (code.nat idx)) (~ subP))))]] (wrap [caseS caseP])) )))) @@ -67,36 +67,36 @@ ## (times +100) (do @ [[valueS pathS] gen-case - to-bind r;nat] + to-bind r.nat] ($_ seq (test "Can translate pattern-matching." - (|> (do macro;Monad<Meta> - [runtime-bytecode @runtime;translate - sampleI (@;translate-case expressionT;translate + (|> (do macro.Monad<Meta> + [runtime-bytecode @runtime.translate + sampleI (@.translate-case expressionT.translate valueS (` ("lux case alt" ("lux case seq" (~ pathS) ("lux case exec" true)) ("lux case seq" ("lux case bind" +0) ("lux case exec" false)))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (:! Bool valueT) - (#e;Error error) + (#e.Error error) false))) (test "Can bind values." - (|> (do macro;Monad<Meta> - [runtime-bytecode @runtime;translate - sampleI (@;translate-case expressionT;translate - (code;nat to-bind) + (|> (do macro.Monad<Meta> + [runtime-bytecode @runtime.translate + sampleI (@.translate-case expressionT.translate + (code.nat to-bind) (` ("lux case seq" ("lux case bind" +0) ("lux case exec" (0)))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) - (n.= to-bind (:! Nat valueT)) + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) + (n/= to-bind (:! Nat valueT)) _ false))))))) diff --git a/new-luxc/test/test/luxc/lang/translation/function.lux b/new-luxc/test/test/luxc/lang/translation/function.lux index 726b51b58..1c3dc6f83 100644 --- a/new-luxc/test/test/luxc/lang/translation/function.lux +++ b/new-luxc/test/test/luxc/lang/translation/function.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -14,86 +14,86 @@ [host] test) (luxc (lang ["ls" synthesis] - (translation [";T" expression] - ["@;" eval] - ["@;" runtime] - ["@;" common]))) + (translation [".T" expression] + ["@." eval] + ["@." runtime] + ["@." common]))) (test/luxc common)) (def: arity-limit Nat +10) (def: arity - (r;Random ls;Arity) - (|> r;nat (r/map (|>. (n.% arity-limit) (n.max +1))))) + (r.Random ls.Arity) + (|> r.nat (r/map (|>> (n/% arity-limit) (n/max +1))))) (def: gen-function - (r;Random [ls;Arity Nat ls;Synthesis]) - (do r;Monad<Random> + (r.Random [ls.Arity Nat ls.Synthesis]) + (do r.Monad<Random> [arity arity - arg (|> r;nat (:: @ map (n.% arity))) - #let [functionS (` ("lux function" (~ (code;nat arity)) [] - ((~ (code;int (nat-to-int (n.inc arg)))))))]] + arg (|> r.nat (:: @ map (n/% arity))) + #let [functionS (` ("lux function" (~ (code.nat arity)) [] + ((~ (code.int (nat-to-int (n/inc arg)))))))]] (wrap [arity arg functionS]))) (context: "Function." (<| (times +100) (do @ [[arity arg functionS] gen-function - cut-off (|> r;nat (:: @ map (n.% arity))) - args (r;list arity r;nat) - #let [arg-value (maybe;assume (list;nth arg args)) - argsS (list/map code;nat args) - last-arg (n.dec arity) - cut-off (|> cut-off (n.min (n.dec last-arg)))]] + cut-off (|> r.nat (:: @ map (n/% arity))) + args (r.list arity r.nat) + #let [arg-value (maybe.assume (list.nth arg args)) + argsS (list/map code.nat args) + last-arg (n/dec arity) + cut-off (|> cut-off (n/min (n/dec last-arg)))]] ($_ seq (test "Can read arguments." - (|> (do macro;Monad<Meta> - [runtime-bytecode @runtime;translate - sampleI (expressionT;translate (` ("lux call" (~ functionS) (~@ argsS))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) - (n.= arg-value (:! Nat valueT)) + (|> (do macro.Monad<Meta> + [runtime-bytecode @runtime.translate + sampleI (expressionT.translate (` ("lux call" (~ functionS) (~@ argsS))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) + (n/= arg-value (:! Nat valueT)) - (#e;Error error) + (#e.Error error) false))) (test "Can partially apply functions." - (or (n.= +1 arity) - (|> (do macro;Monad<Meta> - [#let [partial-arity (n.inc cut-off) - preS (list;take partial-arity argsS) - postS (list;drop partial-arity argsS)] - runtime-bytecode @runtime;translate - sampleI (expressionT;translate (` ("lux call" + (or (n/= +1 arity) + (|> (do macro.Monad<Meta> + [#let [partial-arity (n/inc cut-off) + preS (list.take partial-arity argsS) + postS (list.drop partial-arity argsS)] + runtime-bytecode @runtime.translate + sampleI (expressionT.translate (` ("lux call" ("lux call" (~ functionS) (~@ preS)) (~@ postS))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) - (n.= arg-value (:! Nat valueT)) + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) + (n/= arg-value (:! Nat valueT)) - (#e;Error error) + (#e.Error error) false)))) (test "Can read environment." - (or (n.= +1 arity) - (|> (do macro;Monad<Meta> - [#let [env (|> (list;n.range +0 cut-off) - (list/map (|>. n.inc nat-to-int))) - super-arity (n.inc cut-off) - arg-var (if (n.<= cut-off arg) - (|> arg n.inc nat-to-int (i.* -1)) - (|> arg n.inc (n.- super-arity) nat-to-int)) - sub-arity (|> arity (n.- super-arity)) - functionS (` ("lux function" (~ (code;nat super-arity)) [] - ("lux function" (~ (code;nat sub-arity)) [(~@ (list/map code;int env))] - ((~ (code;int arg-var))))))] - runtime-bytecode @runtime;translate - sampleI (expressionT;translate (` ("lux call" (~ functionS) (~@ argsS))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) - (n.= arg-value (:! Nat valueT)) + (or (n/= +1 arity) + (|> (do macro.Monad<Meta> + [#let [env (|> (list.n/range +0 cut-off) + (list/map (|>> n/inc nat-to-int))) + super-arity (n/inc cut-off) + arg-var (if (n/<= cut-off arg) + (|> arg n/inc nat-to-int (i/* -1)) + (|> arg n/inc (n/- super-arity) nat-to-int)) + sub-arity (|> arity (n/- super-arity)) + functionS (` ("lux function" (~ (code.nat super-arity)) [] + ("lux function" (~ (code.nat sub-arity)) [(~@ (list/map code.int env))] + ((~ (code.int arg-var))))))] + runtime-bytecode @runtime.translate + sampleI (expressionT.translate (` ("lux call" (~ functionS) (~@ argsS))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) + (n/= arg-value (:! Nat valueT)) - (#e;Error error) + (#e.Error error) false)))) )))) diff --git a/new-luxc/test/test/luxc/lang/translation/primitive.lux b/new-luxc/test/test/luxc/lang/translation/primitive.lux index ad4f57107..0d02c5ae7 100644 --- a/new-luxc/test/test/luxc/lang/translation/primitive.lux +++ b/new-luxc/test/test/luxc/lang/translation/primitive.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -11,50 +11,50 @@ [macro] (macro [code]) test) - (luxc (lang [";L" host] + (luxc (lang [".L" host] ["ls" synthesis] - (translation [";T" expression] - ["@;" runtime] - ["@;" eval] - ["@;" common]))) + (translation [".T" expression] + ["@." runtime] + ["@." eval] + ["@." common]))) (test/luxc common)) (context: "Primitives." (<| (times +100) (do @ - [%bool% r;bool - %nat% r;nat - %int% r;int - %deg% r;deg - %frac% r;frac - %text% (r;text +5)] + [%bool% r.bool + %nat% r.nat + %int% r.int + %deg% r.deg + %frac% r.frac + %text% (r.text +5)] (with-expansions [<tests> (do-template [<desc> <type> <synthesis> <sample> <test>] [(test (format "Can translate " <desc> ".") - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (<synthesis> <sample>))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (<synthesis> <sample>))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (<test> <sample> (:! <type> valueT)) _ false)))] - ["bool" Bool code;bool %bool% B/=] - ["nat" Nat code;nat %nat% n.=] - ["int" Int code;int %int% i.=] - ["deg" Deg code;deg %deg% d.=] - ["frac" Frac code;frac %frac% f.=] - ["text" Text code;text %text% T/=])] + ["bool" Bool code.bool %bool% B/=] + ["nat" Nat code.nat %nat% n/=] + ["int" Int code.int %int% i/=] + ["deg" Deg code.deg %deg% d/=] + ["frac" Frac code.frac %frac% f/=] + ["text" Text code.text %text% T/=])] ($_ seq (test "Can translate unit." - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (' []))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) - (is hostL;unit (:! Text valueT)) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (' []))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) + (is hostL.unit (:! Text valueT)) _ false))) diff --git a/new-luxc/test/test/luxc/lang/translation/procedure/common.jvm.lux b/new-luxc/test/test/luxc/lang/translation/procedure/common.jvm.lux index 9eb5050bb..bdfae3a78 100644 --- a/new-luxc/test/test/luxc/lang/translation/procedure/common.jvm.lux +++ b/new-luxc/test/test/luxc/lang/translation/procedure/common.jvm.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -17,58 +17,58 @@ [host] test) (luxc (lang ["ls" synthesis] - (translation [";T" expression] - ["@;" eval] - ["@;" runtime] - ["@;" common]))) + (translation [".T" expression] + ["@." eval] + ["@." runtime] + ["@." common]))) (test/luxc common)) (context: "Bit procedures" (<| (times +100) (do @ - [param r;nat - subject r;nat] + [param r.nat + subject r.nat] (with-expansions [<binary> (do-template [<name> <reference>] [(test <name> - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` (<name> (~ (code;nat subject)) - (~ (code;nat param)))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) - (n.= (<reference> param subject) (:! Nat valueT)) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` (<name> (~ (code.nat subject)) + (~ (code.nat param)))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) + (n/= (<reference> param subject) (:! Nat valueT)) _ false)))] - ["lux bit and" bit;and] - ["lux bit or" bit;or] - ["lux bit xor" bit;xor] - ["lux bit shift-left" bit;shift-left] - ["lux bit unsigned-shift-right" bit;shift-right] + ["lux bit and" bit.and] + ["lux bit or" bit.or] + ["lux bit xor" bit.xor] + ["lux bit shift-left" bit.shift-left] + ["lux bit unsigned-shift-right" bit.shift-right] )] ($_ seq (test "bit count" - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` ("lux bit count" (~ (code;nat subject)))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) - (n.= (bit;count subject) (:! Nat valueT)) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` ("lux bit count" (~ (code.nat subject)))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) + (n/= (bit.count subject) (:! Nat valueT)) _ false))) <binary> (test "bit shift-right" - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` ("lux bit shift-right" - (~ (code;int (nat-to-int subject))) - (~ (code;nat param)))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) - (i.= (bit;signed-shift-right param (nat-to-int subject)) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` ("lux bit shift-right" + (~ (code.int (nat-to-int subject))) + (~ (code.nat param)))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) + (i/= (bit.signed-shift-right param (nat-to-int subject)) (:! Int valueT)) _ @@ -78,17 +78,17 @@ (context: "Nat procedures" (<| (times +100) (do @ - [param (|> r;nat (r;filter (|>. (n.= +0) not))) - subject r;nat] + [param (|> r.nat (r.filter (|>> (n/= +0) not))) + subject r.nat] (`` ($_ seq (~~ (do-template [<name> <reference>] [(test <name> - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` (<name>)))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) - (n.= <reference> (:! Nat valueT)) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` (<name>)))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) + (n/= <reference> (:! Nat valueT)) _ false)))] @@ -98,55 +98,55 @@ )) (~~ (do-template [<name> <type> <prepare> <comp>] [(test <name> - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` (<name> (~ (code;nat subject)))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` (<name> (~ (code.nat subject)))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (<comp> (<prepare> subject) (:! <type> valueT)) _ false)))] - ["lux nat to-int" Int nat-to-int i.=] - ["lux nat to-char" Text text;from-code text/=] + ["lux nat to-int" Int nat-to-int i/=] + ["lux nat to-char" Text text.from-code text/=] )) (~~ (do-template [<name> <reference> <outputT> <comp>] [(test <name> - (|> (do macro;Monad<Meta> - [runtime-bytecode @runtime;translate - sampleI (expressionT;translate (` (<name> (~ (code;nat subject)) (~ (code;nat param)))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (|> (do macro.Monad<Meta> + [runtime-bytecode @runtime.translate + sampleI (expressionT.translate (` (<name> (~ (code.nat subject)) (~ (code.nat param)))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (<comp> (<reference> param subject) (:! <outputT> valueT)) _ false)))] - ["lux nat +" n.+ Nat n.=] - ["lux nat -" n.- Nat n.=] - ["lux nat *" n.* Nat n.=] - ["lux nat /" n./ Nat n.=] - ["lux nat %" n.% Nat n.=] - ["lux nat =" n.= Bool bool/=] - ["lux nat <" n.< Bool bool/=] + ["lux nat +" n/+ Nat n/=] + ["lux nat -" n/- Nat n/=] + ["lux nat *" n/* Nat n/=] + ["lux nat /" n// Nat n/=] + ["lux nat %" n/% Nat n/=] + ["lux nat =" n/= Bool bool/=] + ["lux nat <" n/< Bool bool/=] )) ))))) (context: "Int procedures" (<| (times +100) (do @ - [param (|> r;int (r;filter (|>. (i.= 0) not))) - subject r;int] + [param (|> r.int (r.filter (|>> (i/= 0) not))) + subject r.int] (with-expansions [<nullary> (do-template [<name> <reference>] [(test <name> - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` (<name>)))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) - (i.= <reference> (:! Int valueT)) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` (<name>)))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) + (i/= <reference> (:! Int valueT)) _ false)))] @@ -156,39 +156,39 @@ ) <unary> (do-template [<name> <type> <prepare> <comp>] [(test <name> - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` (<name> (~ (code;int subject)))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` (<name> (~ (code.int subject)))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (<comp> (<prepare> subject) (:! <type> valueT)) _ false)))] - ["lux int to-nat" Nat int-to-nat n.=] - ["lux int to-frac" Frac int-to-frac f.=] + ["lux int to-nat" Nat int-to-nat n/=] + ["lux int to-frac" Frac int-to-frac f/=] ) <binary> (do-template [<name> <reference> <outputT> <comp>] [(test <name> - (|> (do macro;Monad<Meta> - [runtime-bytecode @runtime;translate - sampleI (expressionT;translate (` (<name> (~ (code;int subject)) (~ (code;int param)))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (|> (do macro.Monad<Meta> + [runtime-bytecode @runtime.translate + sampleI (expressionT.translate (` (<name> (~ (code.int subject)) (~ (code.int param)))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (<comp> (<reference> param subject) (:! <outputT> valueT)) _ false)))] - ["lux int +" i.+ Int i.=] - ["lux int -" i.- Int i.=] - ["lux int *" i.* Int i.=] - ["lux int /" i./ Int i.=] - ["lux int %" i.% Int i.=] - ["lux int =" i.= Bool bool/=] - ["lux int <" i.< Bool bool/=] + ["lux int +" i/+ Int i/=] + ["lux int -" i/- Int i/=] + ["lux int *" i/* Int i/=] + ["lux int /" i// Int i/=] + ["lux int %" i/% Int i/=] + ["lux int =" i/= Bool bool/=] + ["lux int <" i/< Bool bool/=] )] ($_ seq <nullary> @@ -199,28 +199,28 @@ (context: "Frac procedures [Part 1]" (<| (times +100) (do @ - [param (|> r;frac (r;filter (|>. (f.= 0.0) not))) - subject r;frac] + [param (|> r.frac (r.filter (|>> (f/= 0.0) not))) + subject r.frac] (with-expansions [<binary> (do-template [<name> <reference> <outputT> <comp>] [(test <name> - (|> (do macro;Monad<Meta> - [runtime-bytecode @runtime;translate - sampleI (expressionT;translate (` (<name> (~ (code;frac subject)) (~ (code;frac param)))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (|> (do macro.Monad<Meta> + [runtime-bytecode @runtime.translate + sampleI (expressionT.translate (` (<name> (~ (code.frac subject)) (~ (code.frac param)))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (<comp> (<reference> param subject) (:! <outputT> valueT)) _ false)))] - ["lux frac +" f.+ Frac f.=] - ["lux frac -" f.- Frac f.=] - ["lux frac *" f.* Frac f.=] - ["lux frac /" f./ Frac f.=] - ["lux frac %" f.% Frac f.=] - ["lux frac =" f.= Bool bool/=] - ["lux frac <" f.< Bool bool/=] + ["lux frac +" f/+ Frac f/=] + ["lux frac -" f/- Frac f/=] + ["lux frac *" f/* Frac f/=] + ["lux frac /" f// Frac f/=] + ["lux frac %" f/% Frac f/=] + ["lux frac =" f/= Bool bool/=] + ["lux frac <" f/< Bool bool/=] )] ($_ seq <binary> @@ -229,55 +229,55 @@ (context: "Frac procedures [Part 2]" (<| (times +100) (do @ - [param (|> r;frac (r;filter (|>. (f.= 0.0) not))) - subject r;frac] + [param (|> r.frac (r.filter (|>> (f/= 0.0) not))) + subject r.frac] (with-expansions [<nullary> (do-template [<name> <test>] [(test <name> - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` (<name>)))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` (<name>)))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (<test> (:! Frac valueT)) _ false)))] - ["lux frac min" (f.= real/bottom)] - ["lux frac max" (f.= real/top)] - ["lux frac not-a-number" number;not-a-number?] - ["lux frac positive-infinity" (f.= number;positive-infinity)] - ["lux frac negative-infinity" (f.= number;negative-infinity)] - ["lux frac smallest" (f.= ("lux frac smallest-value"))] + ["lux frac min" (f/= real/bottom)] + ["lux frac max" (f/= real/top)] + ["lux frac not-a-number" number.not-a-number?] + ["lux frac positive-infinity" (f/= number.positive-infinity)] + ["lux frac negative-infinity" (f/= number.negative-infinity)] + ["lux frac smallest" (f/= ("lux frac smallest"))] ) <unary> (do-template [<name> <type> <prepare> <comp>] [(test <name> - (|> (do macro;Monad<Meta> - [runtime-bytecode @runtime;translate - sampleI (expressionT;translate (` (<name> (~ (code;frac subject)))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (|> (do macro.Monad<Meta> + [runtime-bytecode @runtime.translate + sampleI (expressionT.translate (` (<name> (~ (code.frac subject)))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (<comp> (<prepare> subject) (:! <type> valueT)) _ false)))] - ["lux frac to-int" Int frac-to-int i.=] - ["lux frac to-deg" Deg frac-to-deg d.=] + ["lux frac to-int" Int frac-to-int i/=] + ["lux frac to-deg" Deg frac-to-deg d/=] )] ($_ seq <nullary> <unary> (test "frac encode|decode" - (|> (do macro;Monad<Meta> - [runtime-bytecode @runtime;translate - sampleI (expressionT;translate (` ("lux frac decode" ("lux frac encode" (~ (code;frac subject))))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (^multi (#e;Success valueT) - [(:! (Maybe Frac) valueT) (#;Some value)]) - (f.= subject value) + (|> (do macro.Monad<Meta> + [runtime-bytecode @runtime.translate + sampleI (expressionT.translate (` ("lux frac decode" ("lux frac encode" (~ (code.frac subject))))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (^multi (#e.Success valueT) + [(:! (Maybe Frac) valueT) (#.Some value)]) + (f/= subject value) _ false))) @@ -286,25 +286,25 @@ (def: (above-threshold value) (-> Deg Deg) (let [threshold .000000001 #( 1/(2^30) )#] - (if (d.< threshold value) - (d.+ threshold value) + (if (d/< threshold value) + (d/+ threshold value) value))) (context: "Deg procedures" (<| (times +100) (do @ - [param (|> r;deg (:: @ map above-threshold)) - special r;nat - subject (|> r;deg (:: @ map above-threshold))] + [param (|> r.deg (:: @ map above-threshold)) + special r.nat + subject (|> r.deg (:: @ map above-threshold))] (`` ($_ seq (~~ (do-template [<name> <reference>] [(test <name> - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` (<name>)))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) - (d.= <reference> (:! Deg valueT)) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` (<name>)))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) + (d/= <reference> (:! Deg valueT)) _ false)))] @@ -314,54 +314,54 @@ )) (~~ (do-template [<name> <type> <prepare> <comp>] [(test <name> - (|> (do macro;Monad<Meta> - [runtime-bytecode @runtime;translate - sampleI (expressionT;translate (` (<name> (~ (code;deg subject)))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (|> (do macro.Monad<Meta> + [runtime-bytecode @runtime.translate + sampleI (expressionT.translate (` (<name> (~ (code.deg subject)))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (<comp> (<prepare> subject) (:! <type> valueT)) _ false)))] - ["lux deg to-frac" Frac deg-to-frac f.=] + ["lux deg to-frac" Frac deg-to-frac f/=] )) (~~ (do-template [<name> <reference> <outputT> <comp>] [(test <name> - (|> (do macro;Monad<Meta> - [runtime-bytecode @runtime;translate - sampleI (expressionT;translate (` (<name> (~ (code;deg subject)) (~ (code;deg param)))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (|> (do macro.Monad<Meta> + [runtime-bytecode @runtime.translate + sampleI (expressionT.translate (` (<name> (~ (code.deg subject)) (~ (code.deg param)))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (<comp> (<reference> param subject) (:! <outputT> valueT)) _ false)))] - ["lux deg +" d.+ Deg d.=] - ["lux deg -" d.- Deg d.=] - ["lux deg *" d.* Deg d.=] - ["lux deg /" d./ Deg d.=] - ["lux deg %" d.% Deg d.=] - ["lux deg =" d.= Bool bool/=] - ["lux deg <" d.< Bool bool/=] + ["lux deg +" d/+ Deg d/=] + ["lux deg -" d/- Deg d/=] + ["lux deg *" d/* Deg d/=] + ["lux deg /" d// Deg d/=] + ["lux deg %" d/% Deg d/=] + ["lux deg =" d/= Bool bool/=] + ["lux deg <" d/< Bool bool/=] )) (~~ (do-template [<name> <reference> <outputT> <comp>] [(test <name> - (|> (do macro;Monad<Meta> - [runtime-bytecode @runtime;translate - sampleI (expressionT;translate (` (<name> (~ (code;deg subject)) (~ (code;nat special)))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (|> (do macro.Monad<Meta> + [runtime-bytecode @runtime.translate + sampleI (expressionT.translate (` (<name> (~ (code.deg subject)) (~ (code.nat special)))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (<comp> (<reference> special subject) (:! <outputT> valueT)) _ false)))] - ["lux deg scale" d.scale Deg d.=] - ["lux deg reciprocal" d.reciprocal Deg d.=] + ["lux deg scale" d/scale Deg d/=] + ["lux deg reciprocal" d/reciprocal Deg d/=] )) ))))) diff --git a/new-luxc/test/test/luxc/lang/translation/procedure/host.jvm.lux b/new-luxc/test/test/luxc/lang/translation/procedure/host.jvm.lux index f5b1e97df..5c188da45 100644 --- a/new-luxc/test/test/luxc/lang/translation/procedure/host.jvm.lux +++ b/new-luxc/test/test/luxc/lang/translation/procedure/host.jvm.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -16,39 +16,39 @@ (macro [code]) [host] test) - (luxc (lang [";L" host] + (luxc (lang [".L" host] ["ls" synthesis] - (translation [";T" expression] - ["@;" eval] - ["@;" runtime] - ["@;" common]))) + (translation [".T" expression] + ["@." eval] + ["@." runtime] + ["@." common]))) (test/luxc common)) (context: "Conversions [Part 1]" (<| (times +100) (do @ - [int-sample (|> r;int (:: @ map (i.% 128))) + [int-sample (|> r.int (:: @ map (i/% 128))) #let [frac-sample (int-to-frac int-sample)]] (with-expansions [<2step> (do-template [<step1> <step2> <tag> <sample> <cast> <test>] [(test (format <step1> " / " <step2>) - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (|> (~ (<tag> <sample>)) <step1> <step2> (`)))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (|> (~ (<tag> <sample>)) <step1> <step2> (`)))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (<test> <sample> (:! <cast> valueT)) - (#e;Error error) + (#e.Error error) false)))] - ["jvm convert double-to-float" "jvm convert float-to-double" code;frac frac-sample Frac f.=] - ["jvm convert double-to-int" "jvm convert int-to-double" code;frac frac-sample Frac f.=] - ["jvm convert double-to-long" "jvm convert long-to-double" code;frac frac-sample Frac f.=] + ["jvm convert double-to-float" "jvm convert float-to-double" code.frac frac-sample Frac f/=] + ["jvm convert double-to-int" "jvm convert int-to-double" code.frac frac-sample Frac f/=] + ["jvm convert double-to-long" "jvm convert long-to-double" code.frac frac-sample Frac f/=] - ["jvm convert long-to-float" "jvm convert float-to-long" code;int int-sample Int i.=] - ["jvm convert long-to-int" "jvm convert int-to-long" code;int int-sample Int i.=] - ["jvm convert long-to-short" "jvm convert short-to-long" code;int int-sample Int i.=] - ["jvm convert long-to-byte" "jvm convert byte-to-long" code;int int-sample Int i.=] + ["jvm convert long-to-float" "jvm convert float-to-long" code.int int-sample Int i/=] + ["jvm convert long-to-int" "jvm convert int-to-long" code.int int-sample Int i/=] + ["jvm convert long-to-short" "jvm convert short-to-long" code.int int-sample Int i/=] + ["jvm convert long-to-byte" "jvm convert byte-to-long" code.int int-sample Int i/=] )] ($_ seq <2step> @@ -57,65 +57,65 @@ (context: "Conversions [Part 2]" (<| (times +100) (do @ - [int-sample (|> r;int (:: @ map (|>. (i.% 128) int/abs))) + [int-sample (|> r.int (:: @ map (|>> (i/% 128) int/abs))) #let [frac-sample (int-to-frac int-sample)]] (`` ($_ seq (~~ (do-template [<step1> <step2> <step3> <tag> <sample> <cast> <test>] [(test (format <step1> " / " <step2> " / " <step3>) - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (|> (~ (<tag> <sample>)) <step1> <step2> <step3> (`)))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (|> (~ (<tag> <sample>)) <step1> <step2> <step3> (`)))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (<test> <sample> (:! <cast> valueT)) - (#e;Error error) + (#e.Error error) false)))] - ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-long" code;int int-sample Int i.=] - ["jvm convert long-to-int" "jvm convert int-to-byte" "jvm convert byte-to-long" code;int int-sample Int i.=] - ["jvm convert long-to-int" "jvm convert int-to-short" "jvm convert short-to-long" code;int int-sample Int i.=] - ["jvm convert long-to-float" "jvm convert float-to-int" "jvm convert int-to-long" code;int int-sample Int i.=] - ["jvm convert long-to-int" "jvm convert int-to-float" "jvm convert float-to-long" code;int int-sample Int i.=] + ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-long" code.int int-sample Int i/=] + ["jvm convert long-to-int" "jvm convert int-to-byte" "jvm convert byte-to-long" code.int int-sample Int i/=] + ["jvm convert long-to-int" "jvm convert int-to-short" "jvm convert short-to-long" code.int int-sample Int i/=] + ["jvm convert long-to-float" "jvm convert float-to-int" "jvm convert int-to-long" code.int int-sample Int i/=] + ["jvm convert long-to-int" "jvm convert int-to-float" "jvm convert float-to-long" code.int int-sample Int i/=] )) ))))) (context: "Conversions [Part 3]" (<| (times +100) (do @ - [int-sample (|> r;int (:: @ map (|>. (i.% 128) int/abs))) + [int-sample (|> r.int (:: @ map (|>> (i/% 128) int/abs))) #let [frac-sample (int-to-frac int-sample)]] (`` ($_ seq (~~ (do-template [<step1> <step2> <step3> <step4> <tag> <sample> <cast> <test>] [(test (format <step1> " / " <step2> " / " <step3>) - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (|> (~ (<tag> <sample>)) <step1> <step2> <step3> <step4> (`)))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (|> (~ (<tag> <sample>)) <step1> <step2> <step3> <step4> (`)))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (<test> <sample> (:! <cast> valueT)) - (#e;Error error) + (#e.Error error) false)))] - ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-byte" "jvm convert byte-to-long" code;int int-sample Int i.=] - ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-short" "jvm convert short-to-long" code;int int-sample Int i.=] - ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-int" "jvm convert int-to-long" code;int int-sample Int i.=] + ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-byte" "jvm convert byte-to-long" code.int int-sample Int i/=] + ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-short" "jvm convert short-to-long" code.int int-sample Int i/=] + ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-int" "jvm convert int-to-long" code.int int-sample Int i/=] )) ))))) (def: gen-nat - (r;Random Nat) - (|> r;nat - (r/map (n.% +128)) - (r;filter (|>. (n.= +0) not)))) + (r.Random Nat) + (|> r.nat + (r/map (n/% +128)) + (r.filter (|>> (n/= +0) not)))) (def: gen-int - (r;Random Int) + (r.Random Int) (|> gen-nat (r/map nat-to-int))) (def: gen-frac - (r;Random Frac) + (r.Random Frac) (|> gen-int (r/map int-to-frac))) (do-template [<domain> <generator> <tag> <type> <test> <augmentation> <+> <-> <*> </> <%> <pre> <post>] @@ -126,17 +126,17 @@ #let [subject (<augmentation> param)]] (with-expansions [<tests> (do-template [<procedure> <reference>] [(test <procedure> - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` (<post> ((~ (code;text <procedure>)) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` (<post> ((~ (code.text <procedure>)) (<pre> (~ (<tag> subject))) (<pre> (~ (<tag> param)))))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (<test> (<reference> param subject) (:! <type> valueT)) - (#e;Error error) + (#e.Error error) false)))] [(format "jvm " <domain> " +") <+>] @@ -149,10 +149,10 @@ <tests> )))))] - ["int" gen-int code;int Int i.= (i.* 10) i.+ i.- i.* i./ i.% "jvm convert long-to-int" "jvm convert int-to-long"] - ["long" gen-int code;int Int i.= (i.* 10) i.+ i.- i.* i./ i.% "lux noop" "lux noop"] - ["float" gen-frac code;frac Frac f.= (f.* 10.0) f.+ f.- f.* f./ f.% "jvm convert double-to-float" "jvm convert float-to-double"] - ["double" gen-frac code;frac Frac f.= (f.* 10.0) f.+ f.- f.* f./ f.% "lux noop" "lux noop"] + ["int" gen-int code.int Int i/= (i/* 10) i/+ i/- i/* i// i/% "jvm convert long-to-int" "jvm convert int-to-long"] + ["long" gen-int code.int Int i/= (i/* 10) i/+ i/- i/* i// i/% "lux noop" "lux noop"] + ["float" gen-frac code.frac Frac f/= (f/* 10.0) f/+ f/- f/* f// f/% "jvm convert double-to-float" "jvm convert float-to-double"] + ["double" gen-frac code.frac Frac f/= (f/* 10.0) f/+ f/- f/* f// f/% "lux noop" "lux noop"] ) (do-template [<domain> <post> <convert>] @@ -164,22 +164,22 @@ (`` ($_ seq (~~ (do-template [<procedure> <reference>] [(test <procedure> - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` (<post> ((~ (code;text <procedure>)) - (<convert> (~ (code;nat subject))) - (<convert> (~ (code;nat param)))))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) - (n.= (<reference> param subject) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` (<post> ((~ (code.text <procedure>)) + (<convert> (~ (code.nat subject))) + (<convert> (~ (code.nat param)))))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) + (n/= (<reference> param subject) (:! Nat valueT)) - (#e;Error error) + (#e.Error error) false)))] - [(format "jvm " <domain> " and") bit;and] - [(format "jvm " <domain> " or") bit;or] - [(format "jvm " <domain> " xor") bit;xor] + [(format "jvm " <domain> " and") bit.and] + [(format "jvm " <domain> " or") bit.or] + [(format "jvm " <domain> " xor") bit.xor] )) )))))] @@ -193,26 +193,26 @@ (do @ [param gen-nat subject gen-nat - #let [shift (n.% +10 param)]] + #let [shift (n/% +10 param)]] (`` ($_ seq (~~ (do-template [<procedure> <reference> <type> <test> <pre-subject> <pre>] [(test <procedure> - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` (<post> ((~ (code;text <procedure>)) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` (<post> ((~ (code.text <procedure>)) (<convert> (~ (<pre> subject))) - ("jvm convert long-to-int" (~ (code;nat shift)))))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + ("jvm convert long-to-int" (~ (code.nat shift)))))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (<test> (<reference> shift (<pre-subject> subject)) (:! <type> valueT)) - (#e;Error error) + (#e.Error error) false)))] - [(format "jvm " <domain> " shl") bit;shift-left Nat n.= id code;nat] - [(format "jvm " <domain> " shr") bit;signed-shift-right Int i.= nat-to-int (|>. nat-to-int code;int)] - [(format "jvm " <domain> " ushr") bit;shift-right Nat n.= id code;nat] + [(format "jvm " <domain> " shl") bit.shift-left Nat n/= id code.nat] + [(format "jvm " <domain> " shr") bit.signed-shift-right Int i/= nat-to-int (|>> nat-to-int code.int)] + [(format "jvm " <domain> " ushr") bit.shift-right Nat n/= id code.nat] )) )))))] @@ -228,17 +228,17 @@ subject <generator>] (with-expansions [<tests> (do-template [<procedure> <reference>] [(test <procedure> - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` ((~ (code;text <procedure>)) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` ((~ (code.text <procedure>)) (<pre> (~ (<tag> subject))) (<pre> (~ (<tag> param))))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (bool/= (<reference> param subject) (:! Bool valueT)) - (#e;Error error) + (#e.Error error) false)))] [(format "jvm " <domain> " =") <=>] @@ -248,68 +248,68 @@ <tests> )))))] - ["int" gen-int code;int i.= i.< "jvm convert long-to-int"] - ["long" gen-int code;int i.= i.< "lux noop"] - ["float" gen-frac code;frac f.= f.< "jvm convert double-to-float"] - ["double" gen-frac code;frac f.= f.< "lux noop"] - ["char" gen-int code;int i.= i.< "jvm convert long-to-char"] + ["int" gen-int code.int i/= i/< "jvm convert long-to-int"] + ["long" gen-int code.int i/= i/< "lux noop"] + ["float" gen-frac code.frac f/= f/< "jvm convert double-to-float"] + ["double" gen-frac code.frac f/= f/< "lux noop"] + ["char" gen-int code.int i/= i/< "jvm convert long-to-char"] ) (def: (jvm//array//new dimension class size) - (-> Nat Text Nat ls;Synthesis) - (` ("jvm array new" (~ (code;nat dimension)) (~ (code;text class)) (~ (code;nat size))))) + (-> Nat Text Nat ls.Synthesis) + (` ("jvm array new" (~ (code.nat dimension)) (~ (code.text class)) (~ (code.nat size))))) (def: (jvm//array//write class idx inputS arrayS) - (-> Text Nat ls;Synthesis ls;Synthesis ls;Synthesis) - (` ("jvm array write" (~ (code;text class)) (~ (code;nat idx)) (~ inputS) (~ arrayS)))) + (-> Text Nat ls.Synthesis ls.Synthesis ls.Synthesis) + (` ("jvm array write" (~ (code.text class)) (~ (code.nat idx)) (~ inputS) (~ arrayS)))) (def: (jvm//array//read class idx arrayS) - (-> Text Nat ls;Synthesis ls;Synthesis) - (` ("jvm array read" (~ (code;text class)) (~ (code;nat idx)) (~ arrayS)))) + (-> Text Nat ls.Synthesis ls.Synthesis) + (` ("jvm array read" (~ (code.text class)) (~ (code.nat idx)) (~ arrayS)))) (context: "Array [Part 1]" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1)))) - idx (|> r;nat (:: @ map (n.% size))) - valueZ r;bool + [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1)))) + idx (|> r.nat (:: @ map (n/% size))) + valueZ r.bool valueB gen-int valueS gen-int valueI gen-int - valueL r;int + valueL r.int valueF gen-frac - valueD r;frac + valueD r.frac valueC gen-int] (with-expansions [<array> (do-template [<class> <type> <value> <test> <input> <post>] [(test <class> - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (|> (jvm//array//new +0 <class> size) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (|> (jvm//array//new +0 <class> size) (jvm//array//write <class> idx <input>) (jvm//array//read <class> idx) (~) <post> (`)))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputZ) + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputZ) (<test> <value> (:! <type> outputZ)) - (#e;Error error) + (#e.Error error) false)))] - ["boolean" Bool valueZ bool/= (code;bool valueZ) + ["boolean" Bool valueZ bool/= (code.bool valueZ) "lux noop"] - ["byte" Int valueB i.= (|> (code;int valueB) (~) "jvm convert long-to-byte" (`)) + ["byte" Int valueB i/= (|> (code.int valueB) (~) "jvm convert long-to-byte" (`)) "jvm convert byte-to-long"] - ["short" Int valueS i.= (|> (code;int valueS) (~) "jvm convert long-to-short" (`)) + ["short" Int valueS i/= (|> (code.int valueS) (~) "jvm convert long-to-short" (`)) "jvm convert short-to-long"] - ["int" Int valueI i.= (|> (code;int valueI) (~) "jvm convert long-to-int" (`)) + ["int" Int valueI i/= (|> (code.int valueI) (~) "jvm convert long-to-int" (`)) "jvm convert int-to-long"] - ["long" Int valueL i.= (code;int valueL) + ["long" Int valueL i/= (code.int valueL) "lux noop"] - ["float" Frac valueF f.= (|> (code;frac valueF) (~) "jvm convert double-to-float" (`)) + ["float" Frac valueF f/= (|> (code.frac valueF) (~) "jvm convert double-to-float" (`)) "jvm convert float-to-double"] - ["double" Frac valueD f.= (code;frac valueD) + ["double" Frac valueD f/= (code.frac valueD) "lux noop"] )] ($_ seq @@ -319,72 +319,72 @@ (context: "Array [Part 2]" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1)))) - idx (|> r;nat (:: @ map (n.% size))) - valueZ r;bool + [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1)))) + idx (|> r.nat (:: @ map (n/% size))) + valueZ r.bool valueB gen-int valueS gen-int valueI gen-int - valueL r;int + valueL r.int valueF gen-frac - valueD r;frac + valueD r.frac valueC gen-int] (with-expansions [<array> (do-template [<class> <type> <value> <test> <input> <post>] [(test <class> - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (|> (jvm//array//new +0 <class> size) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (|> (jvm//array//new +0 <class> size) (jvm//array//write <class> idx <input>) (jvm//array//read <class> idx) (~) <post> (`)))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputT) + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputT) (<test> <value> (:! <type> outputT)) - (#e;Error error) + (#e.Error error) false)))] - ["char" Int valueC i.= - (|> (code;int valueC) (~) "jvm convert long-to-int" "jvm convert int-to-char" (`)) + ["char" Int valueC i/= + (|> (code.int valueC) (~) "jvm convert long-to-int" "jvm convert int-to-char" (`)) "jvm convert char-to-long"] - ["java.lang.Long" Int valueL i.= - (code;int valueL) + ["java.lang.Long" Int valueL i/= + (code.int valueL) "lux noop"] )] ($_ seq <array> (test "java.lang.Double (level 1)" - (|> (do macro;Monad<Meta> - [#let [inner (|> ("jvm array new" +0 "java.lang.Double" (~ (code;nat size))) - ("jvm array write" "java.lang.Double" (~ (code;nat idx)) (~ (code;frac valueD))) + (|> (do macro.Monad<Meta> + [#let [inner (|> ("jvm array new" +0 "java.lang.Double" (~ (code.nat size))) + ("jvm array write" "java.lang.Double" (~ (code.nat idx)) (~ (code.frac valueD))) (`))] - sampleI (expressionT;translate (|> ("jvm array new" +1 "java.lang.Double" (~ (code;nat size))) - ("jvm array write" "#Array" (~ (code;nat idx)) (~ inner)) - ("jvm array read" "#Array" (~ (code;nat idx))) - ("jvm array read" "java.lang.Double" (~ (code;nat idx))) + sampleI (expressionT.translate (|> ("jvm array new" +1 "java.lang.Double" (~ (code.nat size))) + ("jvm array write" "#Array" (~ (code.nat idx)) (~ inner)) + ("jvm array read" "#Array" (~ (code.nat idx))) + ("jvm array read" "java.lang.Double" (~ (code.nat idx))) (`)))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputT) - (f.= valueD (:! Frac outputT)) + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputT) + (f/= valueD (:! Frac outputT)) - (#e;Error error) + (#e.Error error) false))) (test "jvm array length" - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` ("jvm array length" ("jvm array new" +0 "java.lang.Object" (~ (code;nat size))))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputT) - (n.= size (:! Nat outputT)) - - (#e;Error error) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` ("jvm array length" ("jvm array new" +0 "java.lang.Object" (~ (code.nat size))))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputT) + (n/= size (:! Nat outputT)) + + (#e.Error error) false))) ))))) -(host;import java.lang.Class +(host.import java/lang/Class (getName [] String)) (def: classes @@ -393,117 +393,117 @@ "java.lang.String" "java.lang.Number")) (def: instances - (List [Text (r;Random ls;Synthesis)]) - (let [gen-boolean (|> r;bool (:: r;Functor<Random> map code;bool)) - gen-integer (|> r;int (:: r;Functor<Random> map code;int)) - gen-double (|> r;frac (:: r;Functor<Random> map code;frac)) - gen-string (|> (r;text +5) (:: r;Functor<Random> map code;text))] + (List [Text (r.Random ls.Synthesis)]) + (let [gen-boolean (|> r.bool (:: r.Functor<Random> map code.bool)) + gen-integer (|> r.int (:: r.Functor<Random> map code.int)) + gen-double (|> r.frac (:: r.Functor<Random> map code.frac)) + gen-string (|> (r.text +5) (:: r.Functor<Random> map code.text))] (list ["java.lang.Boolean" gen-boolean] ["java.lang.Long" gen-integer] ["java.lang.Double" gen-double] ["java.lang.String" gen-string] - ["java.lang.Object" (r;either (r;either gen-boolean + ["java.lang.Object" (r.either (r.either gen-boolean gen-integer) - (r;either gen-double + (r.either gen-double gen-string))]))) (context: "Object." (<| (times +100) (do @ - [#let [num-classes (list;size classes)] - #let [num-instances (list;size instances)] - class-idx (|> r;nat (:: @ map (n.% num-classes))) - instance-idx (|> r;nat (:: @ map (n.% num-instances))) - exception-message (r;text +5) - #let [class (maybe;assume (list;nth class-idx classes)) - [instance-class instance-gen] (maybe;assume (list;nth instance-idx instances)) - exception-message$ (` ["java.lang.String" (~ (code;text exception-message))])] - sample r;int - monitor r;int + [#let [num-classes (list.size classes)] + #let [num-instances (list.size instances)] + class-idx (|> r.nat (:: @ map (n/% num-classes))) + instance-idx (|> r.nat (:: @ map (n/% num-instances))) + exception-message (r.text +5) + #let [class (maybe.assume (list.nth class-idx classes)) + [instance-class instance-gen] (maybe.assume (list.nth instance-idx instances)) + exception-message$ (` ["java.lang.String" (~ (code.text exception-message))])] + sample r.int + monitor r.int instance instance-gen] ($_ seq (test "jvm object null" - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` ("jvm object null?" ("jvm object null"))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputT) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` ("jvm object null?" ("jvm object null"))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputT) (:! Bool outputT) - (#e;Error error) + (#e.Error error) false))) (test "jvm object null?" - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` ("jvm object null?" (~ (code;int sample)))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputT) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` ("jvm object null?" (~ (code.int sample)))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputT) (not (:! Bool outputT)) - (#e;Error error) + (#e.Error error) false))) (test "jvm object synchronized" - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` ("jvm object synchronized" (~ (code;int monitor)) (~ (code;int sample)))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputT) - (i.= sample (:! Int outputT)) - - (#e;Error error) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` ("jvm object synchronized" (~ (code.int monitor)) (~ (code.int sample)))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputT) + (i/= sample (:! Int outputT)) + + (#e.Error error) false))) (test "jvm object throw" - (|> (do macro;Monad<Meta> - [_ @runtime;translate - sampleI (expressionT;translate (` ("lux try" ("lux function" +1 [] + (|> (do macro.Monad<Meta> + [_ @runtime.translate + sampleI (expressionT.translate (` ("lux try" ("lux function" +1 [] ("jvm object throw" ("jvm member invoke constructor" "java.lang.Throwable" (~ exception-message$)))))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputT) - (case (:! (e;Error Top) outputT) - (#e;Error error) - (text;contains? exception-message error) - - (#e;Success outputT) + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputT) + (case (:! (e.Error Top) outputT) + (#e.Error error) + (text.contains? exception-message error) + + (#e.Success outputT) false) - (#e;Error error) + (#e.Error error) false))) (test "jvm object class" - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` ("jvm object class" (~ (code;text class)))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputT) - (|> outputT (:! Class) (Class.getName []) (text/= class)) - - (#e;Error error) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` ("jvm object class" (~ (code.text class)))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputT) + (|> outputT (:! Class) (Class::getName []) (text/= class)) + + (#e.Error error) false))) (test "jvm object instance?" - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` ("jvm object instance?" (~ (code;text instance-class)) (~ instance))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputT) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` ("jvm object instance?" (~ (code.text instance-class)) (~ instance))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputT) (:! Bool outputT) - (#e;Error error) + (#e.Error error) false))) )))) -(host;import java.util.GregorianCalendar +(host.import java/util/GregorianCalendar (#static AD int)) (context: "Member [Field]" (<| (times +100) (do @ - [sample-short (|> r;int (:: @ map (|>. int/abs (i.% 100)))) - sample-string (r;text +5) - other-sample-string (r;text +5) - #let [shortS (` ["short" ("jvm convert long-to-short" (~ (code;int sample-short)))]) - stringS (` ["java.lang.String" (~ (code;text sample-string))]) + [sample-short (|> r.int (:: @ map (|>> int/abs (i/% 100)))) + sample-string (r.text +5) + other-sample-string (r.text +5) + #let [shortS (` ["short" ("jvm convert long-to-short" (~ (code.int sample-short)))]) + stringS (` ["java.lang.String" (~ (code.text sample-string))]) type-codeS (` ["org.omg.CORBA.TypeCode" ("jvm object null")]) idl-typeS (` ["org.omg.CORBA.IDLType" ("jvm object null")]) value-memberS (` ("jvm member invoke constructor" @@ -512,103 +512,103 @@ (~ type-codeS) (~ idl-typeS) (~ shortS)))]] ($_ seq (test "jvm member static get" - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` ("jvm convert int-to-long" ("jvm member static get" "java.util.GregorianCalendar" "AD" "int"))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputT) - (i.= GregorianCalendar.AD (:! Int outputT)) - - (#e;Error error) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` ("jvm convert int-to-long" ("jvm member static get" "java.util.GregorianCalendar" "AD" "int"))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputT) + (i/= GregorianCalendar::AD (:! Int outputT)) + + (#e.Error error) false))) (test "jvm member static put" - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` ("jvm member static put" "java.awt.datatransfer.DataFlavor" "allHtmlFlavor" "java.awt.datatransfer.DataFlavor" + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` ("jvm member static put" "java.awt.datatransfer.DataFlavor" "allHtmlFlavor" "java.awt.datatransfer.DataFlavor" ("jvm member static get" "java.awt.datatransfer.DataFlavor" "allHtmlFlavor" "java.awt.datatransfer.DataFlavor"))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputT) - (is hostL;unit (:! Text outputT)) + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputT) + (is hostL.unit (:! Text outputT)) - (#e;Error error) + (#e.Error error) false))) (test "jvm member virtual get" - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` ("jvm member virtual get" "org.omg.CORBA.ValueMember" "name" "java.lang.String" (~ value-memberS))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputT) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` ("jvm member virtual get" "org.omg.CORBA.ValueMember" "name" "java.lang.String" (~ value-memberS))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputT) (text/= sample-string (:! Text outputT)) - (#e;Error error) + (#e.Error error) false))) (test "jvm member virtual put" - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` ("jvm member virtual get" "org.omg.CORBA.ValueMember" "name" "java.lang.String" + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` ("jvm member virtual get" "org.omg.CORBA.ValueMember" "name" "java.lang.String" ("jvm member virtual put" "org.omg.CORBA.ValueMember" "name" "java.lang.String" - (~ (code;text other-sample-string)) (~ value-memberS)))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputT) + (~ (code.text other-sample-string)) (~ value-memberS)))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputT) (text/= other-sample-string (:! Text outputT)) - (#e;Error error) + (#e.Error error) false))) )))) -(host;import java.lang.Object) +(host.import java/lang/Object) -(host;import (java.util.ArrayList a)) +(host.import (java/util/ArrayList a)) (context: "Member [Method]" (<| (times +100) (do @ - [sample (|> r;int (:: @ map (|>. int/abs (i.% 100)))) - #let [object-longS (` ["java.lang.Object" (~ (code;int sample))]) - intS (` ["int" ("jvm convert long-to-int" (~ (code;int sample)))]) - coded-intS (` ["java.lang.String" (~ (code;text (int/encode sample)))]) + [sample (|> r.int (:: @ map (|>> int/abs (i/% 100)))) + #let [object-longS (` ["java.lang.Object" (~ (code.int sample))]) + intS (` ["int" ("jvm convert long-to-int" (~ (code.int sample)))]) + coded-intS (` ["java.lang.String" (~ (code.text (int/encode sample)))]) array-listS (` ("jvm member invoke constructor" "java.util.ArrayList" (~ intS)))]] ($_ seq (test "jvm member invoke static" - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` ("jvm member invoke static" "java.lang.Long" "decode" "java.lang.Long" (~ coded-intS))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputT) - (i.= sample (:! Int outputT)) - - (#e;Error error) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` ("jvm member invoke static" "java.lang.Long" "decode" "java.lang.Long" (~ coded-intS))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputT) + (i/= sample (:! Int outputT)) + + (#e.Error error) false))) (test "jvm member invoke virtual" - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` ("jvm member invoke virtual" "java.lang.Object" "equals" "boolean" - (~ (code;int sample)) (~ object-longS))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputT) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` ("jvm member invoke virtual" "java.lang.Object" "equals" "boolean" + (~ (code.int sample)) (~ object-longS))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputT) (:! Bool outputT) - (#e;Error error) + (#e.Error error) false))) (test "jvm member invoke interface" - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (` ("jvm member invoke interface" "java.util.Collection" "add" "boolean" + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (` ("jvm member invoke interface" "java.util.Collection" "add" "boolean" (~ array-listS) (~ object-longS))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputT) + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputT) (:! Bool outputT) - (#e;Error error) + (#e.Error error) false))) (test "jvm member invoke constructor" - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate array-listS)] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputT) - (host;instance? ArrayList (:! Object outputT)) - - (#e;Error error) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate array-listS)] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputT) + (host.instance? ArrayList (:! Object outputT)) + + (#e.Error error) false))) )))) diff --git a/new-luxc/test/test/luxc/lang/translation/reference.lux b/new-luxc/test/test/luxc/lang/translation/reference.lux index 1ad68263d..488000e14 100644 --- a/new-luxc/test/test/luxc/lang/translation/reference.lux +++ b/new-luxc/test/test/luxc/lang/translation/reference.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -9,72 +9,72 @@ [macro] (macro [code]) test) - (luxc (lang ["_;" module] + (luxc (lang ["_." module] (host ["$" jvm] (jvm ["$i" inst])) ["ls" synthesis] - (translation [";T" statement] - [";T" eval] - [";T" expression] - [";T" case] - [";T" runtime]))) + (translation [".T" statement] + [".T" eval] + [".T" expression] + [".T" case] + [".T" runtime]))) (test/luxc common)) -(def: nilI $;Inst runtimeT;noneI) +(def: nilI $.Inst runtimeT.noneI) (def: cursorI - $;Inst - (|>. ($i;int 3) - ($i;array runtimeT;$Tuple) - $i;DUP ($i;int 0) ($i;string "") $i;AASTORE - $i;DUP ($i;int 1) ($i;long 0) ($i;wrap #$;Long) $i;AASTORE - $i;DUP ($i;int 2) ($i;long 0) ($i;wrap #$;Long) $i;AASTORE)) + $.Inst + (|>> ($i.int 3) + ($i.array runtimeT.$Tuple) + $i.DUP ($i.int 0) ($i.string "") $i.AASTORE + $i.DUP ($i.int 1) ($i.long 0) ($i.wrap #$.Long) $i.AASTORE + $i.DUP ($i.int 2) ($i.long 0) ($i.wrap #$.Long) $i.AASTORE)) (def: empty-metaI - (|>. ($i;int 2) - ($i;array runtimeT;$Tuple) - $i;DUP ($i;int 0) cursorI $i;AASTORE - $i;DUP ($i;int 1) nilI $i;AASTORE)) + (|>> ($i.int 2) + ($i.array runtimeT.$Tuple) + $i.DUP ($i.int 0) cursorI $i.AASTORE + $i.DUP ($i.int 1) nilI $i.AASTORE)) (context: "Definitions." (<| (times +100) (do @ - [module-name (|> (r;text +5) (r;filter (|>. (text;contains? "/") not))) - def-name (r;text +5) - def-value r;int - #let [valueI (|>. ($i;long def-value) ($i;wrap #$;Long))]] + [module-name (|> (r.text +5) (r.filter (|>> (text.contains? "/") not))) + def-name (r.text +5) + def-value r.int + #let [valueI (|>> ($i.long def-value) ($i.wrap #$.Long))]] ($_ seq (test "Can refer to definitions." - (|> (do macro;Monad<Meta> - [_ (_module;with-module +0 module-name - (statementT;translate-def def-name Int valueI empty-metaI (' {}))) - sampleI (expressionT;translate (code;symbol [module-name def-name]))] - (evalT;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) - (i.= def-value (:! Int valueT)) + (|> (do macro.Monad<Meta> + [_ (_module.with-module +0 module-name + (statementT.translate-def def-name Int valueI empty-metaI (' {}))) + sampleI (expressionT.translate (code.symbol [module-name def-name]))] + (evalT.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) + (i/= def-value (:! Int valueT)) - (#e;Error error) + (#e.Error error) false))) )))) (context: "Variables." (<| (times +100) (do @ - [register (|> r;nat (:: @ map (n.% +100))) - value r;int] + [register (|> r.nat (:: @ map (n/% +100))) + value r.int] ($_ seq (test "Can refer to local variables/registers." - (|> (do macro;Monad<Meta> - [sampleI (caseT;translate-let expressionT;translate + (|> (do macro.Monad<Meta> + [sampleI (caseT.translate-let expressionT.translate register - (code;int value) - (` ((~ (code;int (nat-to-int register))))))] - (evalT;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success outputT) - (i.= value (:! Int outputT)) + (code.int value) + (` ((~ (code.int (nat-to-int register))))))] + (evalT.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success outputT) + (i/= value (:! Int outputT)) - (#e;Error error) + (#e.Error error) false))) )))) diff --git a/new-luxc/test/test/luxc/lang/translation/structure.lux b/new-luxc/test/test/luxc/lang/translation/structure.lux index 68a394261..d61ec185f 100644 --- a/new-luxc/test/test/luxc/lang/translation/structure.lux +++ b/new-luxc/test/test/luxc/lang/translation/structure.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -15,46 +15,46 @@ (macro [code]) [host] test) - (luxc (lang [";L" host] + (luxc (lang [".L" host] ["ls" synthesis] - (translation [";T" expression] - ["@;" eval] - ["@;" runtime] - ["@;" common]))) + (translation [".T" expression] + ["@." eval] + ["@." runtime] + ["@." common]))) (test/luxc common)) -(host;import java.lang.Integer) +(host.import java/lang/Integer) (def: gen-primitive - (r;Random ls;Synthesis) - (r;either (r;either (r;either (r/wrap (' [])) - (r/map code;bool r;bool)) - (r;either (r/map code;nat r;nat) - (r/map code;int r;int))) - (r;either (r;either (r/map code;deg r;deg) - (r/map code;frac r;frac)) - (r/map code;text (r;text +5))))) + (r.Random ls.Synthesis) + (r.either (r.either (r.either (r/wrap (' [])) + (r/map code.bool r.bool)) + (r.either (r/map code.nat r.nat) + (r/map code.int r.int))) + (r.either (r.either (r/map code.deg r.deg) + (r/map code.frac r.frac)) + (r/map code.text (r.text +5))))) (def: (corresponds? [prediction sample]) - (-> [ls;Synthesis Top] Bool) + (-> [ls.Synthesis Top] Bool) (case prediction - [_ (#;Tuple #;Nil)] - (is hostL;unit (:! Text sample)) + [_ (#.Tuple #.Nil)] + (is hostL.unit (:! Text sample)) (^template [<tag> <type> <test>] [_ (<tag> prediction')] - (case (host;try (<test> prediction' (:! <type> sample))) - (#e;Success result) + (case (host.try (<test> prediction' (:! <type> sample))) + (#e.Success result) result - (#e;Error error) + (#e.Error error) false)) - ([#;Bool Bool bool/=] - [#;Nat Nat n.=] - [#;Int Int i.=] - [#;Deg Deg d.=] - [#;Frac Frac f.=] - [#;Text Text text/=]) + ([#.Bool Bool bool/=] + [#.Nat Nat n/=] + [#.Int Int i/=] + [#.Deg Deg d/=] + [#.Frac Frac f/=] + [#.Text Text text/=]) _ false @@ -63,17 +63,17 @@ (context: "Tuples." (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) - members (r;list size gen-primitive)] + [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2)))) + members (r.list size gen-primitive)] (test "Can translate tuple." - (|> (do macro;Monad<Meta> - [sampleI (expressionT;translate (code;tuple members))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (|> (do macro.Monad<Meta> + [sampleI (expressionT.translate (code.tuple members))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (let [valueT (:! (Array Top) valueT)] - (and (n.= size (array;size valueT)) - (list;every? corresponds? (list;zip2 members (array;to-list valueT))))) + (and (n/= size (array.size valueT)) + (list.every? corresponds? (list.zip2 members (array.to-list valueT))))) _ false)))))) @@ -81,28 +81,28 @@ (context: "Variants." (<| (times +100) (do @ - [num-tags (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) - tag (|> r;nat (:: @ map (n.% num-tags))) - #let [last? (n.= (n.dec num-tags) tag)] + [num-tags (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2)))) + tag (|> r.nat (:: @ map (n/% num-tags))) + #let [last? (n/= (n/dec num-tags) tag)] member gen-primitive] (test "Can translate variant." - (|> (do macro;Monad<Meta> - [runtime-bytecode @runtime;translate - sampleI (expressionT;translate (` ((~ (code;nat tag)) (~ (code;bool last?)) (~ member))))] - (@eval;eval sampleI)) - (macro;run (init-compiler [])) - (case> (#e;Success valueT) + (|> (do macro.Monad<Meta> + [runtime-bytecode @runtime.translate + sampleI (expressionT.translate (` ((~ (code.nat tag)) (~ (code.bool last?)) (~ member))))] + (@eval.eval sampleI)) + (macro.run (init-compiler [])) + (case> (#e.Success valueT) (let [valueT (:! (Array Top) valueT)] - (and (n.= +3 (array;size valueT)) - (let [_tag (:! Integer (maybe;assume (array;read +0 valueT))) - _last? (array;read +1 valueT) - _value (:! Top (maybe;assume (array;read +2 valueT)))] - (and (n.= tag (|> _tag host;i2l int-to-nat)) + (and (n/= +3 (array.size valueT)) + (let [_tag (:! Integer (maybe.assume (array.read +0 valueT))) + _last? (array.read +1 valueT) + _value (:! Top (maybe.assume (array.read +2 valueT)))] + (and (n/= tag (|> _tag host.i2l int-to-nat)) (case _last? - (#;Some _last?') + (#.Some _last?') (and last? (text/= "" (:! Text _last?'))) - #;None + #.None (not last?)) (corresponds? [member _value]))))) diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux index b36782517..98043260b 100644 --- a/new-luxc/test/tests.lux +++ b/new-luxc/test/tests.lux @@ -1,32 +1,32 @@ -(;module: +(.module: lux (lux (control monad) [io] (concurrency [promise]) [cli #+ program:] [test]) - (test (luxc (lang (analysis ["_;A" primitive] - ["_;A" structure] - ["_;A" reference] - ["_;A" case] - ["_;A" function] - ["_;A" type] - (procedure ["_;A" common] - ["_;A" host])) - (synthesis ["_;S" primitive] - ["_;S" structure] - (case ["_;S" special]) - ["_;S" function] - ["_;S" procedure] - ["_;S" loop]) - (translation ["_;T" primitive] - ["_;T" structure] - ["_;T" case] - ["_;T" function] - ["_;T" reference] - (procedure ["_;T" common] - ["_;T" host]))) + (test (luxc (lang (analysis ["_.A" primitive] + ["_.A" structure] + ["_.A" reference] + ["_.A" case] + ["_.A" function] + ["_.A" type] + (procedure ["_.A" common] + ["_.A" host])) + (synthesis ["_.S" primitive] + ["_.S" structure] + (case ["_.S" special]) + ["_.S" function] + ["_.S" procedure] + ["_.S" loop]) + (translation ["_.T" primitive] + ["_.T" structure] + ["_.T" case] + ["_.T" function] + ["_.T" reference] + (procedure ["_.T" common] + ["_.T" host]))) ))) (program: args - (test;run)) + (test.run)) |