diff options
Diffstat (limited to '')
23 files changed, 346 insertions, 152 deletions
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux index 873c363bd..469e730de 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux @@ -1,5 +1,9 @@ (.module: [lux (#- i64) + ["." host (#+ import:)] + [data + [number + ["i" int]]] [target [jvm ["." type]]] @@ -18,13 +22,68 @@ (function (_ value) (operation@wrap (_.GETSTATIC Boolean (if value "TRUE" "FALSE") Boolean))))) -(template [<name> <type> <load> <wrap>] - [(def: #export (<name> value) - (-> <type> (Operation Inst)) - (let [loadI (|> value <load>)] - (operation@wrap (|>> loadI <wrap>))))] +(def: #export (i64 value) + (-> (I64 Any) (Operation Inst)) + (case (.int value) + (^template [<int> <instruction>] + <int> + (operation@wrap (|>> <instruction> (_.wrap type.long)))) + ([+0 _.LCONST_0] + [+1 _.LCONST_1]) - [i64 (I64 Any) (<| _.long .int) (_.wrap type.long)] - [f64 Frac _.double (_.wrap type.double)] - [text Text _.string (<|)] - ) + (^template [<int> <instruction>] + <int> + (operation@wrap (|>> <instruction> _.I2L (_.wrap type.long)))) + ([-1 _.ICONST_M1] + ## [+0 _.ICONST_0] + ## [+1 _.ICONST_1] + [+2 _.ICONST_2] + [+3 _.ICONST_3] + [+4 _.ICONST_4] + [+5 _.ICONST_5]) + + _ + (let [loadI (|> value .int _.long)] + (operation@wrap (|>> loadI (_.wrap type.long)))))) + +(import: #long java/lang/Double + (#static doubleToRawLongBits #manual [double] int)) + +(def: d0-bits + Int + (java/lang/Double::doubleToRawLongBits +0.0)) + +(def: #export (f64 value) + (-> Frac (Operation Inst)) + (case value + (^template [<int> <instruction>] + <int> + (operation@wrap (|>> <instruction> (_.wrap type.double)))) + ([+1.0 _.DCONST_1]) + + (^template [<int> <instruction>] + <int> + (operation@wrap (|>> <instruction> _.F2D (_.wrap type.double)))) + ([+2.0 _.FCONST_2]) + + (^template [<int> <instruction>] + <int> + (operation@wrap (|>> <instruction> _.I2D (_.wrap type.double)))) + ([-1.0 _.ICONST_M1] + ## [+0.0 _.ICONST_0] + ## [+1.0 _.ICONST_1] + [+2.0 _.ICONST_2] + [+3.0 _.ICONST_3] + [+4.0 _.ICONST_4] + [+5.0 _.ICONST_5]) + + _ + (let [loadI (if (i.= ..d0-bits + (java/lang/Double::doubleToRawLongBits (:coerce java/lang/Double value))) + _.DCONST_0 + (_.double value))] + (operation@wrap (|>> loadI (_.wrap type.double)))))) + +(def: #export (text value) + (-> Text (Operation Inst)) + (operation@wrap (_.string value))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux index 46f87142a..049c1549a 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux @@ -66,10 +66,18 @@ (def: #export (variant generate archive [lefts right? member]) (Generator [Nat Bit Synthesis]) (do phase.monad - [memberI (generate archive member)] - (wrap (|>> (_.int (.int (if right? - (.inc lefts) - lefts))) + [memberI (generate archive member) + #let [tagI (case (if right? + (.inc lefts) + lefts) + 0 _.ICONST_0 + 1 _.ICONST_1 + 2 _.ICONST_2 + 3 _.ICONST_3 + 4 _.ICONST_4 + 5 _.ICONST_5 + tag (_.int (.int tag)))]] + (wrap (|>> tagI (flagI right?) memberI (_.INVOKESTATIC //.$Runtime diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index a62a056db..8570823b1 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -204,8 +204,9 @@ ["# Actual definitions covered" (%.nat actual-definitions-covered)] ["# Pending definitions to cover" (%.nat (n.- actual-definitions-covered expected-definitions-to-cover))] + ["# Unexpected definitions covered" (%.nat (set.size unexpected))] ["Coverage" coverage] - ["Missing definitions to cover" (report missing)] + ["Pending definitions to cover" (report missing)] ["Unexpected definitions covered" (report unexpected)]))) (def: failure-exit-code -1) diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index ed4150b73..f30f9f8db 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -16,7 +16,7 @@ ["." dictionary] ["." set] ["." row ("#@." functor)]]] - ["." macro] + ["." meta] [world ["." file]]] ["." // #_ @@ -134,7 +134,7 @@ analysis-module (<| (: (Operation .Module)) ///directive.lift-analysis extension.lift - macro.current-module) + meta.current-module) final-buffer (///directive.lift-generation ///generation.buffer) final-registry (///directive.lift-generation @@ -262,7 +262,7 @@ [analysis-module (<| (: (Operation .Module)) ///directive.lift-analysis extension.lift - macro.current-module) + meta.current-module) _ (///directive.lift-generation (///generation.set-buffer temporary-buffer)) _ (///directive.lift-generation diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux index 5ef2dab10..56a99ce97 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux @@ -9,7 +9,7 @@ ["%" format (#+ format)]] [number ["n" nat]]] - ["." macro]] + ["." meta]] [// (#+ Operation) [macro (#+ Expander)] [// @@ -48,7 +48,7 @@ [exprA (type.with-type type (analyze archive exprC)) module (extensionP.lift - macro.current-module-name)] + meta.current-module-name)] (phase.lift (do try.monad [exprS (|> exprA (synthesisP.phase archive) (phase.run synthesis-state))] (phase.run generation-state diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis/macro.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis/macro.lux index 89731a81b..b81f8f227 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/analysis/macro.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/analysis/macro.lux @@ -11,7 +11,7 @@ [collection [array (#+ Array)] ["." list ("#@." functor)]]] - ["." macro]] + ["." meta]] [///// ["." phase]]) @@ -44,7 +44,7 @@ (def: #export (expand-one expander name macro inputs) (-> Expander Name Macro (List Code) (Meta Code)) - (do macro.monad + (do meta.monad [expansion (expand expander name macro inputs)] (case expansion (^ (list single)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux index a5978fcba..e490ba168 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux @@ -7,7 +7,7 @@ [data [text ["%" format (#+ format)]]] - ["." macro]] + ["." meta]] ["." / #_ ["#." type] ["#." primitive] @@ -114,7 +114,7 @@ (case functionA (#/.Reference (#reference.Constant def-name)) (do @ - [?macro (//extension.lift (macro.find-macro def-name))] + [?macro (//extension.lift (meta.find-macro def-name))] (case ?macro (#.Some macro) (do @ diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux index 3c563d300..f0b4faba6 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -16,7 +16,8 @@ ["." list ("#@." fold monoid functor)]]] ["." type ["." check]] - ["." macro + ["." meta] + [macro ["." code]]] ["." / #_ ["#." coverage (#+ Coverage)] @@ -281,8 +282,8 @@ (^ [location (#.Form (list& [_ (#.Tag tag)] values))]) (/.with-location location (do ///.monad - [tag (///extension.lift (macro.normalize tag)) - [idx group variantT] (///extension.lift (macro.resolve-tag tag)) + [tag (///extension.lift (meta.normalize tag)) + [idx group variantT] (///extension.lift (meta.resolve-tag tag)) _ (//type.with-env (check.check inputT variantT)) #let [[lefts right?] (/.choice (list.size group) idx)]] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux index 8426c7577..52b790d60 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -12,7 +12,7 @@ ["." list ("#@." fold monoid monad)]]] ["." type ["." check]] - ["." macro]] + ["." meta]] ["." // #_ ["#." scope] ["#." type] @@ -44,7 +44,7 @@ (def: #export (function analyse function-name arg-name archive body) (-> Phase Text Text Phase) (do {@ ///.monad} - [functionT (///extension.lift macro.expected-type)] + [functionT (///extension.lift meta.expected-type)] (loop [expectedT functionT] (/.with-stack ..cannot-analyse [expectedT function-name arg-name body] (case expectedT diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux index bcde262d2..c0bf41a7e 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux @@ -14,7 +14,7 @@ ["." list ("#@." functor)]]] ["." type ["." check]] - ["." macro]] + ["." meta]] ["." // #_ ["#." type] ["/#" // #_ @@ -94,7 +94,7 @@ (def: new-named-type (Operation Type) (do ///.monad - [location (///extension.lift macro.location) + [location (///extension.lift meta.location) [ex-id _] (//type.with-env check.existential)] (wrap (named-type location ex-id)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux index efa6d96a3..3e06ed0e7 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux @@ -13,7 +13,7 @@ ["." list ("#@." fold functor)] [dictionary ["." plist]]]] - ["." macro]] + ["." meta]] ["." /// #_ ["#." extension] [// @@ -75,8 +75,8 @@ (-> Code (Operation Any)) (///extension.lift (do ///.monad - [self-name macro.current-module-name - self macro.current-module] + [self-name meta.current-module-name + self meta.current-module] (case (get@ #.module-annotations self) #.None (function (_ state) @@ -92,7 +92,7 @@ (-> Text (Operation Any)) (///extension.lift (do ///.monad - [self-name macro.current-module-name] + [self-name meta.current-module-name] (function (_ state) (#try.Success [(update@ #.modules (plist.update self-name (update@ #.imports (function (_ current) @@ -107,7 +107,7 @@ (-> Text Text (Operation Any)) (///extension.lift (do ///.monad - [self-name macro.current-module-name] + [self-name meta.current-module-name] (function (_ state) (#try.Success [(update@ #.modules (plist.update self-name (update@ #.module-aliases (: (-> (List [Text Text]) (List [Text Text])) @@ -129,8 +129,8 @@ (-> Text Global (Operation Any)) (///extension.lift (do ///.monad - [self-name macro.current-module-name - self macro.current-module] + [self-name meta.current-module-name + self meta.current-module] (function (_ state) (case (plist.get name (get@ #.definitions self)) #.None @@ -161,7 +161,7 @@ [_ (create hash name) output (/.with-current-module name action) - module (///extension.lift (macro.find-module name))] + module (///extension.lift (meta.find-module name))] (wrap [module output]))) (template [<setter> <asker> <tag>] @@ -239,7 +239,7 @@ (def: #export (declare-tags tags exported? type) (-> (List Tag) Bit Type (Operation Any)) (do ///.monad - [self-name (///extension.lift macro.current-module-name) + [self-name (///extension.lift meta.current-module-name) [type-module type-name] (case type (#.Named type-name _) (wrap type-name) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/reference.lux index b4e0846a4..827e36a2e 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -4,7 +4,7 @@ monad] [control ["." exception (#+ exception:)]] - ["." macro] + ["." meta] [data ["." text ("#@." equivalence) ["%" format (#+ format)]]]] @@ -32,7 +32,7 @@ (-> Name (Operation Analysis)) (with-expansions [<return> (wrap (|> def-name ///reference.constant #/.Reference))] (do {@ ///.monad} - [constant (///extension.lift (macro.find-def def-name))] + [constant (///extension.lift (meta.find-def def-name))] (case constant (#.Left real-def-name) (definition real-def-name) @@ -40,13 +40,13 @@ (#.Right [exported? actualT def-anns _]) (do @ [_ (//type.infer actualT) - (^@ def-name [::module ::name]) (///extension.lift (macro.normalize def-name)) - current (///extension.lift macro.current-module-name)] + (^@ def-name [::module ::name]) (///extension.lift (meta.normalize def-name)) + current (///extension.lift meta.current-module-name)] (if (text@= current ::module) <return> (if exported? (do @ - [imported! (///extension.lift (macro.imported-by? ::module current))] + [imported! (///extension.lift (meta.imported-by? ::module current))] (if imported! <return> (/.throw foreign-module-has-not-been-imported [current ::module]))) @@ -77,7 +77,7 @@ #.None (do @ - [this-module (///extension.lift macro.current-module-name)] + [this-module (///extension.lift meta.current-module-name)] (definition [this-module simple-name])))) _ diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux index 68da1dd68..1355b25c6 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -18,7 +18,8 @@ ["." dictionary (#+ Dictionary)]]] ["." type ["." check]] - ["." macro + ["." meta] + [macro ["." code]]] ["." // #_ ["#." type] @@ -92,7 +93,7 @@ (let [tag (/.tag lefts right?)] (function (recur valueC) (do {@ ///.monad} - [expectedT (///extension.lift macro.expected-type) + [expectedT (///extension.lift meta.expected-type) expectedT' (//type.with-env (check.clean expectedT))] (/.with-stack ..cannot-analyse-variant [expectedT' tag valueC] @@ -165,7 +166,7 @@ (def: (typed-product archive analyse members) (-> Archive Phase (List Code) (Operation Analysis)) (do {@ ///.monad} - [expectedT (///extension.lift macro.expected-type) + [expectedT (///extension.lift meta.expected-type) membersA+ (: (Operation (List Analysis)) (loop [membersT+ (type.flatten-tuple expectedT) membersC+ members] @@ -192,7 +193,7 @@ (def: #export (product archive analyse membersC) (-> Archive Phase (List Code) (Operation Analysis)) (do {@ ///.monad} - [expectedT (///extension.lift macro.expected-type)] + [expectedT (///extension.lift meta.expected-type)] (/.with-stack ..cannot-analyse-tuple [expectedT membersC] (case expectedT (#.Product _) @@ -259,11 +260,11 @@ (def: #export (tagged-sum analyse tag archive valueC) (-> Phase Name Phase) (do {@ ///.monad} - [tag (///extension.lift (macro.normalize tag)) - [idx group variantT] (///extension.lift (macro.resolve-tag tag)) + [tag (///extension.lift (meta.normalize tag)) + [idx group variantT] (///extension.lift (meta.resolve-tag tag)) #let [case-size (list.size group) [lefts right?] (/.choice case-size idx)] - expectedT (///extension.lift macro.expected-type)] + expectedT (///extension.lift meta.expected-type)] (case expectedT (#.Var _) (do @ @@ -285,7 +286,7 @@ (case key [_ (#.Tag key)] (do ///.monad - [key (///extension.lift (macro.normalize key))] + [key (///extension.lift (meta.normalize key))] (wrap [key val])) _ @@ -304,8 +305,8 @@ (#.Cons [head-k head-v] _) (do {@ ///.monad} - [head-k (///extension.lift (macro.normalize head-k)) - [_ tag-set recordT] (///extension.lift (macro.resolve-tag head-k)) + [head-k (///extension.lift (meta.normalize head-k)) + [_ tag-set recordT] (///extension.lift (meta.resolve-tag head-k)) #let [size-record (list.size record) size-ts (list.size tag-set)] _ (if (n.= size-ts size-record) @@ -316,7 +317,7 @@ idx->val (monad.fold @ (function (_ [key val] idx->val) (do @ - [key (///extension.lift (macro.normalize key))] + [key (///extension.lift (meta.normalize key))] (case (dictionary.get key tag->idx) (#.Some idx) (if (dictionary.contains? idx idx->val) @@ -346,7 +347,7 @@ (do {@ ///.monad} [members (normalize members) [membersC recordT] (order members) - expectedT (///extension.lift macro.expected-type)] + expectedT (///extension.lift meta.expected-type)] (case expectedT (#.Var _) (do @ diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux index 55cd0d1b5..a58a3f323 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux @@ -9,7 +9,7 @@ ["%" format (#+ format)]] [collection ["." list ("#@." fold monoid)]]] - ["." macro]] + ["." meta]] ["." // #_ ["#." extension] ["#." analysis @@ -52,7 +52,7 @@ (case macroA (^ (///analysis.constant macro-name)) (do @ - [?macro (//extension.lift (macro.find-macro macro-name)) + [?macro (//extension.lift (meta.find-macro macro-name)) macro (case ?macro (#.Some macro) (wrap macro) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index d8bf5f17b..7174516a3 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -1,7 +1,7 @@ (.module: [lux (#- Type Module primitive type char int) ["." host (#+ import:)] - ["." macro] + ["." meta] [abstract ["." monad (#+ do)]] [control @@ -375,7 +375,7 @@ (do phase.monad [lengthA (typeA.with-type ..int (analyse archive lengthC)) - expectedT (///.lift macro.expected-type) + expectedT (///.lift meta.expected-type) expectedJT (jvm-array-type expectedT) elementJT (case (jvm-parser.array? expectedJT) (#.Some elementJT) @@ -665,7 +665,7 @@ (case args (^ (list)) (do phase.monad - [expectedT (///.lift macro.expected-type) + [expectedT (///.lift meta.expected-type) _ (check-object expectedT)] (wrap (#/////analysis.Extension extension-name (list)))) @@ -858,7 +858,7 @@ (case args (^ (list fromC)) (do {@ phase.monad} - [toT (///.lift macro.expected-type) + [toT (///.lift meta.expected-type) to-name (:: @ map ..reflection (check-jvm toT)) [fromT fromA] (typeA.with-inference (analyse archive fromC)) @@ -1935,9 +1935,9 @@ (monad.map check.monad (|>> ..signature (luxT.check (luxT.class mapping))) super-interfaces)) - selfT (///.lift (do macro.monad - [where macro.current-module-name - id macro.count] + selfT (///.lift (do meta.monad + [where meta.current-module-name + id meta.count] (wrap (inheritance-relationship-type (#.Primitive (..anonymous-class-name where id) (list)) super-classT super-interfaceT+)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index 690efdcf3..72096032a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -19,7 +19,7 @@ ["." dictionary (#+ Dictionary)]]] [type ["." check]] - ["." macro]] + ["." meta]] ["." /// ["#." bundle] ["/#" // #_ @@ -103,7 +103,7 @@ (do {@ ////.monad} [input (typeA.with-type text.Char (phase archive input)) - expectedT (///.lift macro.expected-type) + expectedT (///.lift meta.expected-type) conditionals (monad.map @ (function (_ [cases branch]) (do @ [branch (typeA.with-type expectedT @@ -163,7 +163,7 @@ (case args (^ (list typeC valueC)) (do {@ ////.monad} - [count (///.lift macro.count) + [count (///.lift meta.count) actualT (:: @ map (|>> (:coerce Type)) (eval archive count Type typeC)) _ (typeA.infer actualT)] @@ -179,7 +179,7 @@ (case args (^ (list typeC valueC)) (do {@ ////.monad} - [count (///.lift macro.count) + [count (///.lift meta.count) actualT (:: @ map (|>> (:coerce Type)) (eval archive count Type typeC)) _ (typeA.infer actualT) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index b03dbd256..391c13cb1 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -17,7 +17,8 @@ ["." dictionary]] [number ["n" nat]]] - ["." macro + ["." meta] + [macro ["." code]] ["." type (#+ :share :by-example) ("#@." equivalence) ["." check]]] @@ -157,7 +158,7 @@ (Operation anchor expression directive [expression Any]))) (do phase.monad [current-module (/////directive.lift-analysis - (///.lift macro.current-module-name))] + (///.lift meta.current-module-name))] (/////directive.lift-generation (do phase.monad [codeG (generate archive codeS) @@ -220,7 +221,7 @@ (^ (list [_ (#.Identifier ["" short-name])] valueC annotationsC [_ (#.Bit exported?)])) (do phase.monad [current-module (/////directive.lift-analysis - (///.lift macro.current-module-name)) + (///.lift meta.current-module-name)) #let [full-name [current-module short-name]] [type valueT value] (..definition archive full-name #.None valueC) [_ annotationsT annotations] (evaluate! archive Code annotationsC) @@ -240,7 +241,7 @@ (function (_ extension-name phase archive [short-name valueC annotationsC tags exported?]) (do phase.monad [current-module (/////directive.lift-analysis - (///.lift macro.current-module-name)) + (///.lift meta.current-module-name)) #let [full-name [current-module short-name]] [_ annotationsT annotations] (evaluate! archive Code annotationsC) #let [annotations (:coerce Code annotations)] @@ -289,8 +290,8 @@ (def: (define-alias alias original) (-> Text Name (/////analysis.Operation Any)) (do phase.monad - [current-module (///.lift macro.current-module-name) - constant (///.lift (macro.find-def original))] + [current-module (///.lift meta.current-module-name) + constant (///.lift (meta.find-def original))] (case constant (#.Left de-aliased) (phase.throw ..cannot-alias-an-alias [[current-module alias] original de-aliased]) @@ -404,7 +405,7 @@ generate (get@ [#/////directive.generation #/////directive.phase] state)] programS (prepare-program archive analyse synthesize programC) current-module (/////directive.lift-analysis - (///.lift macro.current-module-name)) + (///.lift meta.current-module-name)) module-id (phase.lift (archive.id current-module archive)) _ (/////directive.lift-generation (define-program archive module-id generate program programS))] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux index fae712418..64720073a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux @@ -8,7 +8,8 @@ [data [collection ["." list ("#@." functor)]]] - ["." macro (#+ with-gensyms) + ["." meta (#+ with-gensyms)] + [macro ["." code] [syntax (#+ syntax:)]]] ["." /// #_ @@ -30,8 +31,8 @@ (syntax: (arity: {arity s.nat} {name s.local-identifier} type) (with-gensyms [g!_ g!extension g!name g!phase g!archive g!inputs g!of g!anchor g!expression g!directive] - (do {@ macro.monad} - [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] + (do {@ meta.monad} + [g!input+ (monad.seq @ (list.repeat arity (meta.gensym "input")))] (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!extension)) (All [(~ g!anchor) (~ g!expression) (~ g!directive)] (-> ((~ type) (~ g!expression)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux index f49c3b517..798288768 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux @@ -1,13 +1,12 @@ (.module: [lux (#- i64) + ["." host (#+ import:)] [abstract [monad (#+ do)]] [target [jvm ["_" bytecode (#+ Bytecode)] - ["." type]]] - [macro - ["." template]]] + ["." type]]]] ["." // #_ ["#." runtime]]) @@ -19,15 +18,85 @@ (-> Bit (Bytecode Any)) (_.getstatic $Boolean (if value "TRUE" "FALSE") $Boolean)) -(template [<name> <inputT> <ldc> <class> <inputD>] - [(def: #export (<name> value) - (-> <inputT> (Bytecode Any)) - (do _.monad - [_ (`` (|> value (~~ (template.splice <ldc>))))] - (_.invokestatic <class> "valueOf" (type.method [(list <inputD>) <class> (list)]))))] +(def: wrap-i64 + (_.invokestatic $Long "valueOf" (type.method [(list type.long) $Long (list)]))) - [i64 (I64 Any) [.int _.long] $Long type.long] - [f64 Frac [_.double] $Double type.double] - ) +(def: #export (i64 value) + (-> (I64 Any) (Bytecode Any)) + (case (.int value) + (^template [<int> <instruction>] + <int> + (do _.monad + [_ <instruction>] + ..wrap-i64)) + ([+0 _.lconst-0] + [+1 _.lconst-1]) -(def: #export text _.string) + (^template [<int> <instruction>] + <int> + (do _.monad + [_ <instruction> + _ _.i2l] + ..wrap-i64)) + ([-1 _.iconst-m1] + ## [+0 _.iconst-0] + ## [+1 _.iconst-1] + [+2 _.iconst-2] + [+3 _.iconst-3] + [+4 _.iconst-4] + [+5 _.iconst-5]) + + _ + (do _.monad + [_ (|> value .int _.long)] + ..wrap-i64))) + +(def: wrap-f64 + (_.invokestatic $Double "valueOf" (type.method [(list type.double) $Double (list)]))) + +(import: #long java/lang/Double + (#static doubleToRawLongBits #manual [double] int)) + +(def: #export (f64 value) + (-> Frac (Bytecode Any)) + (case value + (^template [<int> <instruction>] + <int> + (do _.monad + [_ <instruction>] + ..wrap-f64)) + ([+1.0 _.dconst-1]) + + (^template [<int> <instruction>] + <int> + (do _.monad + [_ <instruction> + _ _.f2d] + ..wrap-f64)) + ([+2.0 _.fconst-2]) + + (^template [<int> <instruction>] + <int> + (do _.monad + [_ <instruction> + _ _.i2d] + ..wrap-f64)) + ([-1.0 _.iconst-m1] + ## [+0.0 _.iconst-0] + ## [+1.0 _.iconst-1] + [+2.0 _.iconst-2] + [+3.0 _.iconst-3] + [+4.0 _.iconst-4] + [+5.0 _.iconst-5]) + + _ + (let [constantI (if (i.= ..d0-bits + (java/lang/Double::doubleToRawLongBits (:coerce java/lang/Double value))) + _.dconst-0 + (_.double value))] + (do _.monad + [_ constantI] + ..wrap-f64)))) + +(def: #export text + _.string) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux index 361218ece..d48874257 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux @@ -20,9 +20,12 @@ [/// ["." phase]]]]) -(def: $Object (type.class "java.lang.Object" (list))) +(def: $Object + (type.class "java.lang.Object" (list))) -(def: unitG (Bytecode Any) (//primitive.text /////synthesis.unit)) +(def: unitG + (Bytecode Any) + (//primitive.text /////synthesis.unit)) (def: #export (tuple generate archive membersS) (Generator (Tuple Synthesis)) @@ -59,11 +62,19 @@ (def: #export (variant generate archive [lefts right? valueS]) (Generator (Variant Synthesis)) (do phase.monad - [valueI (generate archive valueS)] + [valueI (generate archive valueS) + #let [tagI (case (if right? + (.inc lefts) + lefts) + 0 _.iconst-0 + 1 _.iconst-1 + 2 _.iconst-2 + 3 _.iconst-3 + 4 _.iconst-4 + 5 _.iconst-5 + tag (_.int (.i64 tag)))]] (wrap (do _.monad - [_ (_.int (.i64 (if right? - (.inc lefts) - lefts))) + [_ tagI _ (flagG right?) _ valueI] (_.invokestatic //runtime.class "variant" diff --git a/stdlib/source/spec/lux/abstract/order.lux b/stdlib/source/spec/lux/abstract/order.lux index 4cdb5689a..35aef0c9d 100644 --- a/stdlib/source/spec/lux/abstract/order.lux +++ b/stdlib/source/spec/lux/abstract/order.lux @@ -11,17 +11,47 @@ (def: #export (spec (^open "/@.") generator) (All [a] (-> (/.Order a) (Random a) Test)) (<| (_.with-cover [/.Order]) - (do random.monad - [parameter generator - subject generator]) ($_ _.and - (_.test "Values are either ordered, or they are equal. All options are mutually exclusive." - (cond (/@< parameter subject) - (not (or (/@< subject parameter) - (/@= parameter subject))) + (do random.monad + [parameter generator + subject generator] + (_.test "Values are either ordered, or they are equal. All options are mutually exclusive." + (cond (/@< parameter subject) + (not (or (/@< subject parameter) + (/@= parameter subject))) - (/@< subject parameter) - (not (/@= parameter subject)) + (/@< subject parameter) + (not (/@= parameter subject)) - ## else - (/@= parameter subject)))))) + ## else + (/@= parameter subject)))) + (do random.monad + [parameter generator + subject (random.filter (|>> (/@= parameter) not) + generator) + extra (random.filter (function (_ value) + (not (or (/@= parameter value) + (/@= subject value)))) + generator)] + (_.test "Transitive property." + (if (/@< parameter subject) + (let [greater? (and (/@< subject extra) + (/@< parameter extra)) + lesser? (and (/@< extra parameter) + (/@< extra subject)) + in-between? (and (/@< parameter extra) + (/@< extra subject))] + (or greater? + lesser? + in-between?)) + ## (/@< subject parameter) + (let [greater? (and (/@< extra subject) + (/@< extra parameter)) + lesser? (and (/@< parameter extra) + (/@< subject extra)) + in-between? (and (/@< subject extra) + (/@< extra parameter))] + (or greater? + lesser? + in-between?))))) + ))) diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux index f2741c7d0..836f75aa1 100644 --- a/stdlib/source/test/lux/data/name.lux +++ b/stdlib/source/test/lux/data/name.lux @@ -6,62 +6,70 @@ {[0 #spec] [/ ["$." equivalence] + ["$." order] ["$." codec]]}] [control pipe] [data [number ["n" nat]] - ["." text ("#@." equivalence) - ["%" format (#+ format)]]] + ["." text ("#@." equivalence)]] [math - ["r" random (#+ Random)]]] + ["." random (#+ Random)]]] {1 ["." /]}) (def: (part size) - (-> Nat (r.Random Text)) - (|> (r.unicode size) (r.filter (|>> (text.contains? ".") not)))) + (-> Nat (Random Text)) + (random.filter (|>> (text.contains? ".") not) + (random.unicode size))) (def: #export (name module-size short-size) (-> Nat Nat (Random Name)) - (r.and (..part module-size) - (..part short-size))) + (random.and (..part module-size) + (..part short-size))) (def: #export test Test - (<| (_.context (%.name (name-of .Name))) - (do {@ r.monad} + (<| (_.covering /._) + (do {@ random.monad} [## First Name - sizeM1 (|> r.nat (:: @ map (n.% 100))) - sizeS1 (|> r.nat (:: @ map (|>> (n.% 100) (n.max 1)))) + sizeM1 (|> random.nat (:: @ map (n.% 100))) + sizeS1 (|> random.nat (:: @ map (|>> (n.% 100) (n.max 1)))) (^@ name1 [module1 short1]) (..name sizeM1 sizeS1) ## Second Name - sizeM2 (|> r.nat (:: @ map (n.% 100))) - sizeS2 (|> r.nat (:: @ map (|>> (n.% 100) (n.max 1)))) + sizeM2 (|> random.nat (:: @ map (n.% 100))) + sizeS2 (|> random.nat (:: @ map (|>> (n.% 100) (n.max 1)))) (^@ name2 [module2 short2]) (..name sizeM2 sizeS2)] - ($_ _.and - ($equivalence.spec /.equivalence (..name sizeM1 sizeS1)) - ($codec.spec /.equivalence /.codec (..name sizeM1 sizeS1)) - - (_.test "Can get the module / short parts of an name." - (and (is? module1 (/.module name1)) - (is? short1 (/.short name1)))) - (let [(^open "/@.") /.codec] - (_.test "Encoding an name without a module component results in text equal to the short of the name." - (if (text.empty? module1) - (text@= short1 (/@encode name1)) - #1))) - (let [(^open "/@.") /.equivalence] - ($_ _.and - (_.test "Can obtain Name from identifier." - (and (/@= ["lux" "yolo"] (name-of .yolo)) - (/@= ["test/lux/data/name" "yolo"] (name-of ..yolo)) - (/@= ["" "yolo"] (name-of yolo)) - (/@= ["lux/test" "yolo"] (name-of lux/test.yolo)))) - (_.test "Can obtain Name from tag." - (and (/@= ["lux" "yolo"] (name-of #.yolo)) - (/@= ["test/lux/data/name" "yolo"] (name-of #..yolo)) - (/@= ["" "yolo"] (name-of #yolo)) - (/@= ["lux/test" "yolo"] (name-of #lux/test.yolo)))))) - )))) + (_.with-cover [.Name] + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence (..name sizeM1 sizeS1))) + (_.with-cover [/.order] + ($order.spec /.order (..name sizeM1 sizeS1))) + (_.with-cover [/.codec] + (_.and ($codec.spec /.equivalence /.codec (..name sizeM1 sizeS1)) + (let [(^open "/@.") /.codec] + (_.test "Encoding an name without a module component results in text equal to the short of the name." + (if (text.empty? module1) + (text@= short1 (/@encode name1)) + #1))))) + + (_.cover [/.module /.short] + (and (is? module1 (/.module name1)) + (is? short1 (/.short name1)))) + + (_.with-cover [.name-of] + (let [(^open "/@.") /.equivalence] + ($_ _.and + (_.test "Can obtain Name from identifier." + (and (/@= ["lux" "yolo"] (.name-of .yolo)) + (/@= ["test/lux/data/name" "yolo"] (.name-of ..yolo)) + (/@= ["" "yolo"] (.name-of yolo)) + (/@= ["lux/test" "yolo"] (.name-of lux/test.yolo)))) + (_.test "Can obtain Name from tag." + (and (/@= ["lux" "yolo"] (.name-of #.yolo)) + (/@= ["test/lux/data/name" "yolo"] (.name-of #..yolo)) + (/@= ["" "yolo"] (.name-of #yolo)) + (/@= ["lux/test" "yolo"] (.name-of #lux/test.yolo))))))) + ))))) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index f2468ab4f..511635a2a 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -577,8 +577,10 @@ comparison (: (-> (Bytecode Any) (-> java/lang/Float java/lang/Float Bit) (Random Bit)) (function (_ instruction standard) (do random.monad - [reference ..$Float::random - subject ..$Float::random + [#let [valid-float (random.filter (|>> host.float-to-double (:coerce Frac) f.not-a-number? not) + ..$Float::random)] + reference valid-float + subject valid-float #let [expected (if (for {@.old ("jvm feq" reference subject) @@ -671,8 +673,10 @@ comparison (: (-> (Bytecode Any) (-> java/lang/Double java/lang/Double Bit) (Random Bit)) (function (_ instruction standard) (do random.monad - [reference ..$Double::random - subject ..$Double::random + [#let [valid-double (random.filter (|>> (:coerce Frac) f.not-a-number? not) + ..$Double::random)] + reference valid-double + subject valid-double #let [expected (if (for {@.old ("jvm deq" reference subject) |