From e8f99539a71febaca6013d72d30f6afc33059b4e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 13 Jul 2018 20:03:50 -0400 Subject: - Fixes for compiler build [part 0]. --- .../test/lux/language/compiler/analysis/case.lux | 26 +- .../lux/language/compiler/analysis/function.lux | 29 +- .../lux/language/compiler/analysis/primitive.lux | 22 +- .../compiler/analysis/procedure/common.lux | 36 +- .../compiler/analysis/procedure/host.jvm.lux | 551 --------------------- .../lux/language/compiler/analysis/reference.lux | 59 +-- .../lux/language/compiler/analysis/structure.lux | 88 ++-- .../test/lux/language/compiler/synthesis/case.lux | 28 +- .../lux/language/compiler/synthesis/function.lux | 44 +- .../lux/language/compiler/synthesis/primitive.lux | 32 +- .../lux/language/compiler/synthesis/structure.lux | 35 +- 11 files changed, 212 insertions(+), 738 deletions(-) delete mode 100644 stdlib/test/test/lux/language/compiler/analysis/procedure/host.jvm.lux (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux/language/compiler/analysis/case.lux b/stdlib/test/test/lux/language/compiler/analysis/case.lux index 66b1b0b12..4e01ae3bd 100644 --- a/stdlib/test/test/lux/language/compiler/analysis/case.lux +++ b/stdlib/test/test/lux/language/compiler/analysis/case.lux @@ -13,14 +13,14 @@ [set]]] [math ["r" random ("random/" Monad)]] - [macro (#+ Monad) + [macro [code]] [language ["." type - ["tc" check]] - [".L" module] - [compiler + [check]] + ["." compiler ["." analysis + [module] [".A" type] ["/" case]]]] test] @@ -149,7 +149,7 @@ variantTC (list.zip2 variant-tags+ primitivesC)] inputC (input variant-tags+ record-tags+ primitivesC) [outputT outputC] _primitive.primitive - [heterogeneousT heterogeneousC] (r.filter (|>> product.left (tc.checks? outputT) not) + [heterogeneousT heterogeneousC] (r.filter (|>> product.left (check.checks? outputT) not) _primitive.primitive) exhaustive-patterns (exhaustive-branches true variantTC inputC) redundant-patterns (exhaustive-branches false variantTC inputC) @@ -171,14 +171,14 @@ analyse-pm (|>> (/.case _primitive.analyse inputC) (typeA.with-type outputT) analysis.with-scope - (do Monad - [_ (moduleL.declare-tags variant-tags false - (#.Named [module-name variant-name] - (type.variant primitivesT))) - _ (moduleL.declare-tags record-tags false - (#.Named [module-name record-name] - (type.tuple primitivesT)))]) - (moduleL.with-module +0 module-name))]] + (do compiler.Monad + [_ (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)))]) + (module.with-module +0 module-name))]] ($_ seq (test "Will reject empty pattern-matching (no branches)." (|> (analyse-pm (list)) diff --git a/stdlib/test/test/lux/language/compiler/analysis/function.lux b/stdlib/test/test/lux/language/compiler/analysis/function.lux index bc1a24811..1edbfd949 100644 --- a/stdlib/test/test/lux/language/compiler/analysis/function.lux +++ b/stdlib/test/test/lux/language/compiler/analysis/function.lux @@ -16,30 +16,31 @@ ["r" random]] ["." macro [code]] - [language] - [language - [type ("type/" Equivalence)] - [".L" reference] - [compiler - [".L" init] - [".L" analysis (#+ Analysis) + ["." language + [type] + [reference] + ["." compiler + [init] + [analysis (#+ Analysis Operation) [".A" type] - [".A" expression] - ["/" function]]]] + [expression] + ["/" function]] + [extension + [".E" analysis]]]] test] [// ["_." primitive] ["_." structure]]) -(def: analyse (expressionA.analyser (:coerce language.Eval []))) +(def: analyse (expression.analyser (:coerce language.Eval []))) (def: (check-apply expectedT num-args analysis) - (-> Type Nat (Meta Analysis) Bool) + (-> Type Nat (Operation Analysis) Bool) (|> analysis (typeA.with-type expectedT) - (macro.run (initL.compiler [])) + (compiler.run [analysisE.bundle (init.compiler [])]) (case> (#e.Success applyA) - (let [[funcA argsA] (analysisL.application applyA)] + (let [[funcA argsA] (analysis.application applyA)] (n/= num-args (list.size argsA))) (#e.Error error) @@ -99,7 +100,7 @@ partial-polyT2 (<| (type.univ-q +1) (type.function (#.Cons varT partial-poly-inputsT)) varT) - dummy-function (#analysisL.Function (list) (#analysisL.Reference (referenceL.local +1)))]] + dummy-function (#analysis.Function (list) (#analysis.Reference (reference.local +1)))]] ($_ seq (test "Can analyse monomorphic type application." (|> (/.apply ..analyse funcT dummy-function inputsC) diff --git a/stdlib/test/test/lux/language/compiler/analysis/primitive.lux b/stdlib/test/test/lux/language/compiler/analysis/primitive.lux index ba841fbfe..8cd764b00 100644 --- a/stdlib/test/test/lux/language/compiler/analysis/primitive.lux +++ b/stdlib/test/test/lux/language/compiler/analysis/primitive.lux @@ -10,18 +10,20 @@ [text format]] [math ["r" random ("random/" Monad)]] - ["." macro + [macro [code]] ["." language [".L" type ("type/" Equivalence)] - [compiler - [".L" init] - [analysis (#+ Analysis) + ["." compiler + [init] + [analysis (#+ Analysis Operation) [".A" type] - [".A" expression]]]] + [expression]] + [extension + [".E" analysis]]]] test]) -(def: #export analyse (expressionA.analyser (:coerce language.Eval []))) +(def: #export analyse (expression.analyser (:coerce language.Eval []))) (def: unit (r.Random Code) @@ -47,10 +49,10 @@ ["Inferred" (%type inferred)])) (def: (infer-primitive expected-type analysis) - (-> Type (Meta Analysis) (e.Error Analysis)) - (|> (typeA.with-inference - analysis) - (macro.run (initL.compiler [])) + (-> Type (Operation Analysis) (e.Error Analysis)) + (|> analysis + typeA.with-inference + (compiler.run [analysisE.bundle (init.compiler [])]) (case> (#e.Success [inferred-type output]) (if (is? expected-type inferred-type) (#e.Success output) diff --git a/stdlib/test/test/lux/language/compiler/analysis/procedure/common.lux b/stdlib/test/test/lux/language/compiler/analysis/procedure/common.lux index 1f7021039..e3b8cc9b5 100644 --- a/stdlib/test/test/lux/language/compiler/analysis/procedure/common.lux +++ b/stdlib/test/test/lux/language/compiler/analysis/procedure/common.lux @@ -13,15 +13,17 @@ [collection [array]]] [math ["r" random]] - [macro (#+ Monad) + [macro [code]] - ["." language + [language [type ("type/" Equivalence)] - [".L" scope] - [compiler - [".L" init] + ["." compiler + [init] [analysis - [".A" type]]]] + [scope] + [".A" type]] + [extension + [".E" analysis]]]] test] [/// ["_." primitive]]) @@ -29,10 +31,10 @@ (do-template [ ] [(def: ( procedure params output-type) (-> Text (List Code) Type Bool) - (|> (scopeL.with-scope "" + (|> (scope.with-scope "" (typeA.with-type output-type (_primitive.analyse (` ((~ (code.text procedure)) (~+ params)))))) - (macro.run (initL.compiler [])) + (compiler.run [analysisE.bundle (init.compiler [])]) (case> (#e.Success _) @@ -177,11 +179,11 @@ #let [arrayT (type (Array elemT)) g!array (code.local-symbol var-name) array-operation (function (_ output-type code) - (|> (scopeL.with-scope "" - (scopeL.with-local [var-name arrayT] + (|> (scope.with-scope "" + (scope.with-local [var-name arrayT] (typeA.with-type output-type (_primitive.analyse code)))) - (macro.run (initL.compiler [])) + (compiler.run [analysisE.bundle (init.compiler [])]) (case> (#e.Success _) true @@ -247,25 +249,25 @@ (test "Can create atomic reference." (check-success+ "lux atom new" (list elemC) atomT)) (test "Can read the value of an atomic reference." - (|> (scopeL.with-scope "" - (scopeL.with-local [var-name atomT] + (|> (scope.with-scope "" + (scope.with-local [var-name atomT] (typeA.with-type elemT (_primitive.analyse (` ("lux atom read" (~ (code.symbol ["" var-name])))))))) - (macro.run (initL.compiler [])) + (compiler.run [analysisE.bundle (init.compiler [])]) (case> (#e.Success _) true (#e.Error _) false))) (test "Can swap the value of an atomic reference." - (|> (scopeL.with-scope "" - (scopeL.with-local [var-name atomT] + (|> (scope.with-scope "" + (scope.with-local [var-name atomT] (typeA.with-type Bool (_primitive.analyse (` ("lux atom compare-and-swap" (~ (code.symbol ["" var-name])) (~ elemC) (~ elemC))))))) - (macro.run (initL.compiler [])) + (compiler.run [analysisE.bundle (init.compiler [])]) (case> (#e.Success _) true diff --git a/stdlib/test/test/lux/language/compiler/analysis/procedure/host.jvm.lux b/stdlib/test/test/lux/language/compiler/analysis/procedure/host.jvm.lux deleted file mode 100644 index 02574a31a..000000000 --- a/stdlib/test/test/lux/language/compiler/analysis/procedure/host.jvm.lux +++ /dev/null @@ -1,551 +0,0 @@ -(.module: - [lux #* - [io] - [control - [monad (#+ do)] - pipe] - [concurrency - [atom]] - [data - ["e" error] - [product] - [maybe] - [text ("text/" Equivalence) - format] - [collection - [array] - [list ("list/" Fold)] - ["dict" dictionary]]] - [math - ["r" random "r/" Monad]] - [macro (#+ Monad) - [code]] - ["." language - [type] - [compiler - [".L" init] - [analysis - [".A" type]] - [extension - [analysis - [".AE" host]]]]] - test] - [/// - ["_." primitive]]) - -(do-template [ ] - [(def: ( procedure params output-type) - (-> Text (List Code) Type Bool) - (|> (do Monad - [## runtime-bytecode @runtime.translate - ] - (language.with-scope - (typeA.with-type output-type - (_primitive.analyse (` ((~ (code.text procedure)) (~+ params))))))) - (language.with-current-module "") - (macro.run (initL.compiler [])) - (case> (#e.Success _) - - - (#e.Error error) - )))] - - [success true false] - [failure false true] - ) - -(do-template [ ] - [(def: ( syntax output-type) - (-> Code Type Bool) - (|> (do Monad - [## runtime-bytecode @runtime.translate - ] - (language.with-scope - (typeA.with-type output-type - (_primitive.analyse syntax)))) - (language.with-current-module "") - (macro.run (initL.compiler [])) - (case> (#e.Success _) - - - (#e.Error error) - )))] - - [success' true false] - [failure' false true] - ) - -(context: "Conversions [double + float]." - (with-expansions [ (do-template [ ] - [(test (format " SUCCESS") - (success (list (' ("lux coerce" (+0 (+0)) []))) )) - (test (format " FAILURE") - (failure (list (' [])) ))] - - ["jvm convert double-to-float" "java.lang.Double" hostAE.Float] - ["jvm convert double-to-int" "java.lang.Double" hostAE.Integer] - ["jvm convert double-to-long" "java.lang.Double" hostAE.Long] - ["jvm convert float-to-double" "java.lang.Float" hostAE.Double] - ["jvm convert float-to-int" "java.lang.Float" hostAE.Integer] - ["jvm convert float-to-long" "java.lang.Float" hostAE.Long] - )] - ($_ seq - - ))) - -(context: "Conversions [int]." - (with-expansions [ (do-template [ ] - [(test (format " SUCCESS") - (success (list (' ("lux coerce" (+0 (+0)) []))) )) - (test (format " FAILURE") - (failure (list (' [])) ))] - - ["jvm convert int-to-byte" "java.lang.Integer" hostAE.Byte] - ["jvm convert int-to-char" "java.lang.Integer" hostAE.Character] - ["jvm convert int-to-double" "java.lang.Integer" hostAE.Double] - ["jvm convert int-to-float" "java.lang.Integer" hostAE.Float] - ["jvm convert int-to-long" "java.lang.Integer" hostAE.Long] - ["jvm convert int-to-short" "java.lang.Integer" hostAE.Short] - )] - ($_ seq - - ))) - -(context: "Conversions [long]." - (with-expansions [ (do-template [ ] - [(test (format " SUCCESS") - (success (list (' ("lux coerce" (+0 (+0)) []))) )) - (test (format " FAILURE") - (failure (list (' [])) ))] - - ["jvm convert long-to-double" "java.lang.Long" hostAE.Double] - ["jvm convert long-to-float" "java.lang.Long" hostAE.Float] - ["jvm convert long-to-int" "java.lang.Long" hostAE.Integer] - ["jvm convert long-to-short" "java.lang.Long" hostAE.Short] - ["jvm convert long-to-byte" "java.lang.Long" hostAE.Byte] - )] - ($_ seq - - ))) - -(context: "Conversions [char + byte + short]." - (with-expansions [ (do-template [ ] - [(test (format " SUCCESS") - (success (list (' ("lux coerce" (+0 (+0)) []))) )) - (test (format " FAILURE") - (failure (list (' [])) ))] - - ["jvm convert char-to-byte" "java.lang.Character" hostAE.Byte] - ["jvm convert char-to-short" "java.lang.Character" hostAE.Short] - ["jvm convert char-to-int" "java.lang.Character" hostAE.Integer] - ["jvm convert char-to-long" "java.lang.Character" hostAE.Long] - ["jvm convert byte-to-long" "java.lang.Byte" hostAE.Long] - ["jvm convert short-to-long" "java.lang.Short" hostAE.Long] - )] - ($_ seq - - ))) - -(do-template [ ] - [(context: (format "Arithmetic " "[" "].") - (with-expansions [ (do-template [ ] - [(test - (success - (list (' ("lux coerce" (+0 (+0)) [])) - (' ("lux coerce" (+0 (+0)) []))) - ))] - - [(format "jvm " " +") ] - [(format "jvm " " -") ] - [(format "jvm " " *") ] - [(format "jvm " " /") ] - [(format "jvm " " %") ] - )] - ($_ seq - - ))) - - (context: (format "Order " "[" "].") - (with-expansions [ (do-template [ ] - [(test - (success - (list (' ("lux coerce" (+0 (+0)) [])) - (' ("lux coerce" (+0 (+0)) []))) - ))] - - [(format "jvm " " =") hostAE.Boolean] - [(format "jvm " " <") hostAE.Boolean] - )] - ($_ seq - - ))) - - (context: (format "Bitwise " "[" "].") - (with-expansions [ (do-template [ ] - [(test - (success - (list (' ("lux coerce" (+0 (+0)) [])) - (' ("lux coerce" (+0 (+0)) []))) - ))] - - [(format "jvm " " and") ] - [(format "jvm " " or") ] - [(format "jvm " " xor") ] - [(format "jvm " " shl") "java.lang.Integer" ] - [(format "jvm " " shr") "java.lang.Integer" ] - [(format "jvm " " ushr") "java.lang.Integer" ] - )] - ($_ seq - - )))] - - - ["int" "java.lang.Integer" hostAE.Integer] - ["long" "java.lang.Long" hostAE.Long] - ) - -(do-template [ ] - [(context: (format "Arithmetic " "[" "].") - (with-expansions [ (do-template [ ] - [(test - (success - (list (' ("lux coerce" (+0 (+0)) [])) - (' ("lux coerce" (+0 (+0)) []))) - ))] - - [(format "jvm " " +") ] - [(format "jvm " " -") ] - [(format "jvm " " *") ] - [(format "jvm " " /") ] - [(format "jvm " " %") ] - )] - ($_ seq - - ))) - - (context: (format "Order " "[" "].") - (with-expansions [ (do-template [ ] - [(test - (success - (list (' ("lux coerce" (+0 (+0)) [])) - (' ("lux coerce" (+0 (+0)) []))) - ))] - - [(format "jvm " " =") hostAE.Boolean] - [(format "jvm " " <") hostAE.Boolean] - )] - ($_ seq - - )))] - - - ["float" "java.lang.Float" hostAE.Float] - ["double" "java.lang.Double" hostAE.Double] - ) - -(do-template [ ] - [(context: (format "Order " "[" "].") - (with-expansions [ (do-template [ ] - [(test - (success - (list (' ("lux coerce" (+0 (+0)) [])) - (' ("lux coerce" (+0 (+0)) []))) - ))] - - [(format "jvm " " =") hostAE.Boolean] - [(format "jvm " " <") hostAE.Boolean] - )] - ($_ seq - - )))] - - - ["char" "java.lang.Character" hostAE.Character] - ) - -(def: array-type - (r.Random [Text Text]) - (let [entries (dict.entries hostAE.boxes) - num-entries (list.size entries)] - (do r.Monad - [choice (|> r.nat (:: @ map (n/% (inc num-entries)))) - #let [[unboxed boxed] (: [Text Text] - (|> entries - (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))] - [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))) - multi-arrayT (list/fold (function (_ _ innerT) - (|> innerT (list) (#.Primitive "#Array"))) - boxedT - (list.n/range +1 level))]] - ($_ seq - (test "jvm array new" - (success "jvm array new" - (list (code.nat size)) - arrayT)) - (test "jvm array new (no nesting)" - (failure "jvm array new" - (list (code.nat size)) - unboxedT)) - (test "jvm array new (nested/multi-level)" - (success "jvm array new" - (list (code.nat size)) - multi-arrayT)) - (test "jvm array length" - (success "jvm array length" - (list arrayC) - Nat)) - (test "jvm array read" - (success' (` ("jvm object cast" - ("jvm array read" (~ arrayC) (~ (code.nat idx))))) - boxedT)) - (test "jvm array write" - (success "jvm array write" - (list arrayC (code.nat idx) (`' ("lux coerce" (~ boxedTC) []))) - arrayT)) - )))) - -(def: throwables - (List Text) - (list "java.lang.Throwable" - "java.lang.Error" - "java.io.IOError" - "java.lang.VirtualMachineError" - "java.lang.Exception" - "java.io.IOException" - "java.lang.RuntimeException")) - -(context: "Object." - (<| (times +100) - (do @ - [[unboxed boxed] array-type - [!unboxed !boxed] (|> array-type - (r.filter (function (_ [!unboxed !boxed]) - (not (text/= boxed !boxed))))) - #let [boxedT (#.Primitive boxed (list)) - boxedC (`' ("lux check" (+0 (~ (code.text boxed)) (+0)) - ("jvm object null"))) - !boxedC (`' ("lux check" (+0 (~ (code.text !boxed)) (+0)) - ("jvm object null"))) - unboxedC (`' ("lux check" (+0 (~ (code.text unboxed)) (+0)) - ("jvm object null")))] - throwable (|> r.nat - (:: @ map (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)) - ("jvm object null")))]] - ($_ seq - (test "jvm object null" - (success "jvm object null" - (list) - (#.Primitive boxed (list)))) - (test "jvm object null (no primitives)" - (or (text/= "java.lang.Object" boxed) - (failure "jvm object null" - (list) - (#.Primitive unboxed (list))))) - (test "jvm object null?" - (success "jvm object null?" - (list boxedC) - Bool)) - (test "jvm object synchronized" - (success "jvm object synchronized" - (list boxedC boxedC) - boxedT)) - (test "jvm object synchronized (no primitives)" - (or (text/= "java.lang.Object" boxed) - (failure "jvm object synchronized" - (list unboxedC boxedC) - boxedT))) - (test "jvm object throw" - (or (text/= "java.lang.Object" throwable) - (success "jvm object throw" - (list throwableC) - Nothing))) - (test "jvm object class" - (success "jvm object class" - (list (code.text boxed)) - (#.Primitive "java.lang.Class" (list boxedT)))) - (test "jvm object instance?" - (success "jvm object instance?" - (list (code.text boxed) - boxedC) - Bool)) - (test "jvm object instance? (lineage)" - (success "jvm object instance?" - (list (' "java.lang.Object") - boxedC) - Bool)) - (test "jvm object instance? (no lineage)" - (or (text/= "java.lang.Object" boxed) - (failure "jvm object instance?" - (list (code.text boxed) - !boxedC) - Bool))) - )))) - -(context: "Member [Static Field]." - ($_ 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)))) - (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)))) - (test "jvm member static put" - (success "jvm member static put" - (list (code.text "java.awt.datatransfer.DataFlavor") - (code.text "allHtmlFlavor") - (`' ("lux check" (+0 "java.awt.datatransfer.DataFlavor" (+0)) - ("jvm object null")))) - Any)) - (test "jvm member static put (final)" - (failure "jvm member static put" - (list (code.text "java.lang.System") - (code.text "out") - (`' ("lux check" (+0 "java.io.PrintStream" (+0)) - ("jvm object null")))) - Any)) - (test "jvm member static put (inheritance in)" - (success "jvm member static put" - (list (code.text "java.awt.datatransfer.DataFlavor") - (code.text "allHtmlFlavor") - (`' ("jvm object cast" - ("lux check" (+0 "javax.activation.ActivationDataFlavor" (+0)) - ("jvm object null"))))) - Any)) - )) - -(context: "Member [Virtual Field]." - ($_ seq - (test "jvm member virtual get" - (success "jvm member virtual get" - (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)))) - (test "jvm member virtual get (inheritance out)" - (success "jvm member virtual get" - (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)))) - (test "jvm member virtual put" - (success "jvm member virtual put" - (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"))) - (test "jvm member virtual put (final)" - (failure "jvm member virtual put" - (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"))) - (test "jvm member virtual put (inheritance in)" - (success "jvm member virtual put" - (list (code.text "java.awt.GridBagConstraints") - (code.text "insets") - (`' ("jvm object cast" - ("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"))) - )) - -(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)))) - (test "jvm member virtual get" - (success "jvm member virtual get" - (list (code.text "javax.accessibility.AccessibleAttributeSequence") - (code.text "startIndex") - (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0)) - ("jvm object null")))) - (#.Primitive "java.lang.Integer" (list)))) - (test "jvm member virtual put" - (success "jvm member virtual put" - (list (code.text "javax.accessibility.AccessibleAttributeSequence") - (code.text "startIndex") - (`' ("jvm object cast" - ("lux check" (+0 "java.lang.Integer" (+0)) - ("jvm object null")))) - (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0)) - ("jvm object null")))) - (primitive "javax.accessibility.AccessibleAttributeSequence"))) - )) - -(context: "Member [Method]." - (let [longC (' ("lux coerce" (+0 "java.lang.Long" (+0)) - +123)) - intC (`' ("jvm convert long-to-int" (~ longC))) - stringC (' ("lux coerce" (+0 "java.lang.String" (+0)) - "YOLO")) - objectC (`' ("lux check" (+0 "java.util.ArrayList" (+1 (+0 "java.lang.Long" (+0)) (+0))) - ("jvm member invoke constructor" "java.util.ArrayList" - ["int" ("jvm object cast" (~ intC))])))] - ($_ seq - (test "jvm member invoke static" - (success' (` ("jvm member invoke static" - "java.lang.Long" "decode" - ["java.lang.String" (~ stringC)])) - (#.Primitive "java.lang.Long" (list)))) - (test "jvm member invoke virtual" - (success' (` ("jvm object cast" - ("jvm member invoke virtual" - "java.lang.Object" "equals" - ("jvm object cast" (~ longC)) ["java.lang.Object" ("jvm object cast" (~ longC))]))) - (#.Primitive "java.lang.Boolean" (list)))) - (test "jvm member invoke special" - (success' (` ("jvm object cast" - ("jvm member invoke special" - "java.lang.Long" "equals" - ("jvm object cast" (~ longC)) ["java.lang.Object" ("jvm object cast" (~ longC))]))) - (#.Primitive "java.lang.Boolean" (list)))) - (test "jvm member invoke interface" - (success' (` ("jvm object cast" - ("jvm member invoke interface" - "java.util.Collection" "add" - ("jvm object cast" (~ objectC)) ["java.lang.Object" ("jvm object cast" (~ longC))]))) - (#.Primitive "java.lang.Boolean" (list)))) - (test "jvm member invoke constructor" - (success' (` ("jvm member invoke constructor" - "java.util.ArrayList" - ["int" ("jvm object cast" (~ intC))])) - (All [a] (#.Primitive "java.util.ArrayList" (list a))))) - ))) diff --git a/stdlib/test/test/lux/language/compiler/analysis/reference.lux b/stdlib/test/test/lux/language/compiler/analysis/reference.lux index aaad40584..00ab606a3 100644 --- a/stdlib/test/test/lux/language/compiler/analysis/reference.lux +++ b/stdlib/test/test/lux/language/compiler/analysis/reference.lux @@ -10,23 +10,26 @@ [text ("text/" Equivalence)]] [math ["r" random]] - [macro (#+ Monad) [code]] + [macro + [code]] ["." language] [language [type ("type/" Equivalence)] - [".L" scope] - [".L" module] - [".L" reference] - [compiler - [".L" init] - [".L" analysis + [reference] + ["." compiler + [init] + ["." analysis + [scope] + [module] [".A" type] - [".A" expression]]]] + [expression]] + [extension + [".E" analysis]]]] test] [// ["_." primitive]]) -(def: analyse (expressionA.analyser (:coerce language.Eval []))) +(def: analyse (expression.analyser (:coerce language.Eval []))) (type: Check (-> (e.Error Any) Bool)) @@ -45,21 +48,21 @@ (def: (reach-test var-name [export? def-module] [import? dependent-module] check!) (-> Text [Bool Text] [Bool Text] Check Bool) - (|> (do Monad - [_ (moduleL.with-module +0 def-module - (moduleL.define var-name [Any - (if export? - (' {#.export? true}) - (' {})) - []]))] - (moduleL.with-module +0 dependent-module + (|> (do compiler.Monad + [_ (module.with-module +0 def-module + (module.define var-name [Any + (if export? + (' {#.export? true}) + (' {})) + []]))] + (module.with-module +0 dependent-module (do @ [_ (if import? - (moduleL.import def-module) + (module.import def-module) (wrap []))] (typeA.with-inference (..analyse (code.symbol [def-module var-name])))))) - (macro.run (initL.compiler [])) + (compiler.run [analysisE.bundle (init.compiler [])]) check!)) (context: "References" @@ -73,12 +76,12 @@ (r.filter (|>> (text/= def-module) not)))] ($_ seq (test "Can analyse variable." - (|> (scopeL.with-scope scope-name - (scopeL.with-local [var-name expectedT] + (|> (scope.with-scope scope-name + (scope.with-local [var-name expectedT] (typeA.with-inference (..analyse (code.local-symbol var-name))))) - (macro.run (initL.compiler [])) - (case> (^ (#e.Success [inferredT (#analysisL.Reference (referenceL.local var))])) + (compiler.run [analysisE.bundle (init.compiler [])]) + (case> (^ (#e.Success [inferredT (#analysis.Reference (reference.local var))])) (and (type/= expectedT inferredT) (n/= +0 var)) @@ -86,13 +89,13 @@ false))) (test "Can analyse definition (in the same module)." (let [def-name [def-module var-name]] - (|> (do Monad - [_ (moduleL.define var-name [expectedT (' {}) []])] + (|> (do compiler.Monad + [_ (module.define var-name [expectedT (' {}) []])] (typeA.with-inference (..analyse (code.symbol def-name)))) - (moduleL.with-module +0 def-module) - (macro.run (initL.compiler [])) - (case> (^ (#e.Success [_ inferredT (#analysisL.Reference (referenceL.constant constant-name))])) + (module.with-module +0 def-module) + (compiler.run [analysisE.bundle (init.compiler [])]) + (case> (^ (#e.Success [_ inferredT (#analysis.Reference (reference.constant constant-name))])) (and (type/= expectedT inferredT) (ident/= def-name constant-name)) diff --git a/stdlib/test/test/lux/language/compiler/analysis/structure.lux b/stdlib/test/test/lux/language/compiler/analysis/structure.lux index 2777ad93b..664e6e29f 100644 --- a/stdlib/test/test/lux/language/compiler/analysis/structure.lux +++ b/stdlib/test/test/lux/language/compiler/analysis/structure.lux @@ -1,6 +1,5 @@ (.module: [lux #* - [io] [control [monad (#+ do)] pipe] @@ -9,35 +8,36 @@ ["e" error] [product] [maybe] - ["." text - format] + ["." text] [collection [list ("list/" Functor)] [set]]] [math ["r" random]] - ["." macro + [macro [code]] ["." language [type ("type/" Equivalence) - ["tc" check]] - [".L" module] - [compiler - [".L" init] - [".L" analysis (#+ Analysis Variant Tag) + [check]] + ["." compiler + [init] + [analysis (#+ Analysis Variant Tag Operation) + [module] [".A" type] ["/" structure] - [".A" expression]]]] + [expression]] + [extension + [".E" analysis]]]] test] [// ["_." primitive]]) -(def: analyse (expressionA.analyser (:coerce language.Eval []))) +(def: analyse (expression.analyser (:coerce language.Eval []))) (do-template [ ] [(def: #export - (All [a] (-> (Meta a) Bool)) - (|>> (macro.run (initL.compiler [])) + (All [a] (-> (Operation a) Bool)) + (|>> (compiler.run [analysisE.bundle (init.compiler [])]) (case> (#e.Success _) @@ -50,20 +50,20 @@ (def: (check-sum' size tag variant) (-> Nat Tag (Variant Analysis) Bool) - (let [variant-tag (if (get@ #analysisL.right? variant) - (inc (get@ #analysisL.lefts variant)) - (get@ #analysisL.lefts variant))] + (let [variant-tag (if (get@ #analysis.right? variant) + (inc (get@ #analysis.lefts variant)) + (get@ #analysis.lefts variant))] (|> size dec (n/= tag) - (bool/= (get@ #analysisL.right? variant)) + (bool/= (get@ #analysis.right? variant)) (and (n/= tag variant-tag))))) (def: (check-sum type size tag analysis) - (-> Type Nat Tag (Meta Analysis) Bool) + (-> Type Nat Tag (Operation Analysis) Bool) (|> analysis (typeA.with-type type) - (macro.run (initL.compiler [])) + (compiler.run [analysisE.bundle (init.compiler [])]) (case> (^multi (#e.Success sumA) - [(analysisL.variant sumA) + [(analysis.variant sumA) (#.Some variant)]) (check-sum' size tag variant) @@ -71,19 +71,19 @@ false))) (def: (tagged module tags type) - (All [a] (-> Text (List moduleL.Tag) Type (Meta a) (Meta [Module a]))) - (|>> (do macro.Monad - [_ (moduleL.declare-tags tags false type)]) - (moduleL.with-module +0 module))) + (All [a] (-> Text (List module.Tag) Type (Operation a) (Operation [Module a]))) + (|>> (do compiler.Monad + [_ (module.declare-tags tags false type)]) + (module.with-module +0 module))) (def: (check-variant module tags type size tag analysis) - (-> Text (List moduleL.Tag) Type Nat Tag (Meta Analysis) Bool) + (-> Text (List module.Tag) Type Nat Tag (Operation Analysis) Bool) (|> analysis (tagged module tags type) (typeA.with-type type) - (macro.run (initL.compiler [])) + (compiler.run [analysisE.bundle (init.compiler [])]) (case> (^multi (#e.Success [_ sumA]) - [(analysisL.variant sumA) + [(analysis.variant sumA) (#.Some variant)]) (check-sum' size tag variant) @@ -92,13 +92,13 @@ (def: (right-size? size) (-> Nat (-> Analysis Bool)) - (|>> analysisL.tuple list.size (n/= size))) + (|>> analysis.tuple list.size (n/= size))) (def: (check-record-inference module tags type size analysis) - (-> Text (List moduleL.Tag) Type Nat (Meta [Type Analysis]) Bool) + (-> Text (List module.Tag) Type Nat (Operation [Type Analysis]) Bool) (|> analysis (tagged module tags type) - (macro.run (initL.compiler [])) + (compiler.run [analysisE.bundle (init.compiler [])]) (case> (#e.Success [_ productT productA]) (and (type/= type productT) (right-size? size productA)) @@ -127,23 +127,23 @@ (check-sum variantT size choice (/.sum ..analyse choice valueC))) (test "Can analyse sum through bound type-vars." - (|> (do macro.Monad - [[_ varT] (typeA.with-env tc.var) + (|> (do compiler.Monad + [[_ varT] (typeA.with-env check.var) _ (typeA.with-env - (tc.check varT variantT))] + (check.check varT variantT))] (typeA.with-type varT (/.sum ..analyse choice valueC))) - (macro.run (initL.compiler [])) + (compiler.run [analysisE.bundle (init.compiler [])]) (case> (^multi (#e.Success sumA) - [(analysisL.variant sumA) + [(analysis.variant sumA) (#.Some variant)]) (check-sum' size choice variant) _ false))) (test "Cannot analyse sum through unbound type-vars." - (|> (do macro.Monad - [[_ varT] (typeA.with-env tc.var)] + (|> (do compiler.Monad + [[_ varT] (typeA.with-env check.var)] (typeA.with-type varT (/.sum ..analyse choice valueC))) check-fails)) @@ -177,7 +177,7 @@ (test "Can analyse product." (|> (typeA.with-type tupleT (/.product ..analyse (list/map product.right primitives))) - (macro.run (initL.compiler [])) + (compiler.run [analysisE.bundle (init.compiler [])]) (case> (#e.Success tupleA) (right-size? size tupleA) @@ -186,7 +186,7 @@ (test "Can infer product." (|> (typeA.with-inference (/.product ..analyse (list/map product.right primitives))) - (macro.run (initL.compiler [])) + (compiler.run [analysisE.bundle (init.compiler [])]) (case> (#e.Success [_type tupleA]) (and (type/= tupleT _type) (right-size? size tupleA)) @@ -198,13 +198,13 @@ (..analyse (` [(~ singletonC)]))) check-succeeds)) (test "Can analyse product through bound type-vars." - (|> (do macro.Monad - [[_ varT] (typeA.with-env tc.var) + (|> (do compiler.Monad + [[_ varT] (typeA.with-env check.var) _ (typeA.with-env - (tc.check varT (type.tuple (list/map product.left primitives))))] + (check.check varT (type.tuple (list/map product.left primitives))))] (typeA.with-type varT (/.product ..analyse (list/map product.right primitives)))) - (macro.run (initL.compiler [])) + (compiler.run [analysisE.bundle (init.compiler [])]) (case> (#e.Success tupleA) (right-size? size tupleA) @@ -290,7 +290,7 @@ (/.record ..analyse recordC)) (check-record-inference module-name tags named-polyT size))) (test "Can specialize generic records." - (|> (do macro.Monad + (|> (do compiler.Monad [recordA (typeA.with-type tupleT (/.record ..analyse recordC))] (wrap [tupleT recordA])) diff --git a/stdlib/test/test/lux/language/compiler/synthesis/case.lux b/stdlib/test/test/lux/language/compiler/synthesis/case.lux index 7ae02d943..264bc0967 100644 --- a/stdlib/test/test/lux/language/compiler/synthesis/case.lux +++ b/stdlib/test/test/lux/language/compiler/synthesis/case.lux @@ -1,16 +1,20 @@ (.module: - lux - (lux (control [monad (#+ do)] - pipe) - (data [error ("error/" Functor)]) - (language ["///." reference] - ["///." compiler] - [".L" analysis (#+ Branch Analysis)] - ["//" synthesis (#+ Synthesis)] - (synthesis [".S" expression]) - [".L" extension]) - ["r" math/random] - test) + [lux #* + [control + [monad (#+ do)] + pipe] + [data + [error ("error/" Functor)]] + [language + ["///." reference] + ["///." compiler + [".L" analysis (#+ Branch Analysis)] + ["//" synthesis (#+ Synthesis) + [".S" expression]] + [".L" extension]]] + [math + ["r" random]] + test] [//primitive]) (context: "Dummy variables." diff --git a/stdlib/test/test/lux/language/compiler/synthesis/function.lux b/stdlib/test/test/lux/language/compiler/synthesis/function.lux index 8bbc1401d..51b2a2e17 100644 --- a/stdlib/test/test/lux/language/compiler/synthesis/function.lux +++ b/stdlib/test/test/lux/language/compiler/synthesis/function.lux @@ -1,24 +1,28 @@ (.module: - lux - (lux [io] - (control [monad (#+ do)] - pipe) - (data [product] - [maybe] - [error] - [number] - text/format - (collection [list ("list/" Functor Fold)] - ["dict" dictionary (#+ Dictionary)] - [set])) - (language ["///." reference (#+ Variable) ("variable/" Equivalence)] - ["///." compiler] - [".L" analysis (#+ Arity Analysis)] - ["//" synthesis (#+ Synthesis)] - (synthesis [".S" expression]) - [".L" extension]) - ["r" math/random] - test) + [lux #* + [io] + [control + [monad (#+ do)] + pipe] + [data + [product] + [maybe] + [error] + [number] + [text format] + [collection + [list ("list/" Functor Fold)] + ["dict" dictionary (#+ Dictionary)] + [set]]] + [language + ["///." reference (#+ Variable) ("variable/" Equivalence)] + ["///." compiler + [".L" analysis (#+ Arity Analysis)] + ["//" synthesis (#+ Synthesis) + [".S" expression]] + [".L" extension]]] + [math ["r" random]] + test] [//primitive]) (def: constant-function diff --git a/stdlib/test/test/lux/language/compiler/synthesis/primitive.lux b/stdlib/test/test/lux/language/compiler/synthesis/primitive.lux index e90d8cb26..3bea7682d 100644 --- a/stdlib/test/test/lux/language/compiler/synthesis/primitive.lux +++ b/stdlib/test/test/lux/language/compiler/synthesis/primitive.lux @@ -1,18 +1,22 @@ (.module: - [lux (#- primitive)] - (lux [io] - (control [monad (#+ do)] - pipe) - (data [error] - text/format) - [language] - (language [".L" extension] - ["///." compiler] - [".L" analysis (#+ Analysis)] - ["//" synthesis (#+ Synthesis)] - (synthesis [".S" expression])) - ["r" math/random] - test)) + [lux (#- primitive) + [io] + [control + [monad (#+ do)] + pipe] + [data + [error] + [text + format]] + ["." language + ["///." compiler + [".L" analysis (#+ Analysis)] + ["//" synthesis (#+ Synthesis) + [".S" expression]] + [".L" extension]]] + [math + ["r" random]] + test]) (def: #export primitive (r.Random Analysis) diff --git a/stdlib/test/test/lux/language/compiler/synthesis/structure.lux b/stdlib/test/test/lux/language/compiler/synthesis/structure.lux index 8dba248e5..0b9f705ff 100644 --- a/stdlib/test/test/lux/language/compiler/synthesis/structure.lux +++ b/stdlib/test/test/lux/language/compiler/synthesis/structure.lux @@ -1,19 +1,24 @@ (.module: - lux - (lux [io] - (control [monad (#+ do)] - pipe) - (data [bool ("bool/" Equivalence)] - [product] - [error] - (collection [list])) - (language ["///." compiler] - [".L" analysis] - ["//" synthesis (#+ Synthesis)] - (synthesis [".S" expression]) - [".L" extension]) - (math ["r" random]) - test) + [lux #* + [io] + [control + [monad (#+ do)] + pipe] + [data + [bool ("bool/" Equivalence)] + [product] + [error] + [collection + [list]]] + [language + ["///." compiler + [".L" analysis] + ["//" synthesis (#+ Synthesis) + [".S" expression]] + [".L" extension]]] + [math + ["r" random]] + test] [//primitive]) (context: "Variants" -- cgit v1.2.3