From c218bc693aa3703fee666c3ca1c068201c07d2a9 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 6 Jun 2019 22:44:00 -0400 Subject: WIP: Class definition. --- stdlib/source/test/lux/host.jvm.lux | 56 +++--- .../test/lux/tool/compiler/phase/analysis.lux | 4 +- .../compiler/phase/extension/analysis/common.lux | 201 --------------------- .../tool/compiler/phase/extension/analysis/lux.lux | 201 +++++++++++++++++++++ 4 files changed, 233 insertions(+), 229 deletions(-) delete mode 100644 stdlib/source/test/lux/tool/compiler/phase/extension/analysis/common.lux create mode 100644 stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/host.jvm.lux b/stdlib/source/test/lux/host.jvm.lux index c9446b857..f142a1912 100644 --- a/stdlib/source/test/lux/host.jvm.lux +++ b/stdlib/source/test/lux/host.jvm.lux @@ -11,28 +11,32 @@ {1 ["." / (#+ import: class: interface: object)]}) -(import: (java/util/concurrent/Callable a)) +(import: #long (java/util/concurrent/Callable a)) -(import: java/lang/Exception - (new [String])) +(import: #long java/lang/String) -(import: java/lang/Object) +(import: #long java/lang/Exception + (new [java/lang/String])) -(import: (java/lang/Class a) - (getName [] String)) +(import: #long java/lang/Object) -(import: java/lang/System +(import: #long (java/lang/Class a) + (getName [] java/lang/String)) + +(import: #long java/lang/Runnable) + +(import: #long java/lang/System (#static out java/io/PrintStream) (#static currentTimeMillis [] #io long) - (#static getenv [String] #io #? String)) + (#static getenv [java/lang/String] #io #? java/lang/String)) -(class: #final (TestClass A) [Runnable] +(class: #final (TestClass A) [java/lang/Runnable] ## Fields (#private foo boolean) (#private bar A) (#private baz java/lang/Object) ## Methods - (#public [] (new {value A}) [] + (#public [] (new self {value A}) [] (exec (:= ::foo #1) (:= ::bar value) (:= ::baz "") @@ -41,23 +45,23 @@ "") (#public #static (static) java/lang/Object "") - (Runnable [] (run self) void - [])) + (java/lang/Runnable [] (run self) void + [])) (def: test-runnable - (object [] [Runnable] + (object [] [java/lang/Runnable] [] - (Runnable [] (run self) void - []))) + (java/lang/Runnable [] (run self) void + []))) (def: test-callable - (object [a] [(Callable a)] + (object [a] [(java/util/concurrent/Callable a)] [] - (Callable [] (call self) a - (undefined)))) + (java/util/concurrent/Callable [] (call self) a + (undefined)))) (interface: TestInterface - ([] foo [boolean String] void #throws [Exception])) + ([] foo [boolean java/lang/String] void #throws [java/lang/Exception])) (def: conversions Test @@ -85,26 +89,26 @@ [sample (r.ascii 1)] ($_ _.and (_.test "Can check if an object is of a certain class." - (and (case (/.check String sample) (#.Some _) true #.None false) - (case (/.check Long sample) (#.Some _) false #.None true) - (case (/.check Object sample) (#.Some _) true #.None false) - (case (/.check Object (/.null)) (#.Some _) false #.None true))) + (and (case (/.check java/lang/String sample) (#.Some _) true #.None false) + (case (/.check java/lang/Long sample) (#.Some _) false #.None true) + (case (/.check java/lang/Object sample) (#.Some _) true #.None false) + (case (/.check java/lang/Object (/.null)) (#.Some _) false #.None true))) (_.test "Can run code in a 'synchronized' block." (/.synchronized sample #1)) (_.test "Can access Class instances." - (text;= "java.lang.Class" (Class::getName (/.class-for java/lang/Class)))) + (text;= "java.lang.Class" (java/lang/Class::getName (/.class-for java/lang/Class)))) (_.test "Can check if a value is null." (and (/.null? (/.null)) (not (/.null? sample)))) (_.test "Can safely convert nullable references into Maybe values." - (and (|> (: (Maybe Object) (/.??? (/.null))) + (and (|> (: (Maybe java/lang/Object) (/.??? (/.null))) (case> #.None #1 _ #0)) - (|> (: (Maybe Object) (/.??? sample)) + (|> (: (Maybe java/lang/Object) (/.??? sample)) (case> (#.Some _) #1 _ #0)))) ))) diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis.lux index d24feb8be..06b09fbf9 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/analysis.lux @@ -10,7 +10,7 @@ ["/#" // #_ [extension [analysis - ["#." common]]]]]) + ["#." lux]]]]]) (def: #export test Test @@ -20,5 +20,5 @@ /reference.test /case.test /function.test - //common.test + //lux.test )) diff --git a/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/common.lux b/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/common.lux deleted file mode 100644 index e45656025..000000000 --- a/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/common.lux +++ /dev/null @@ -1,201 +0,0 @@ -(.module: - [lux (#- i64 int primitive) - [abstract ["." monad (#+ do)]] - [data - text/format - ["." name]] - ["r" math/random (#+ Random) ("#@." monad)] - ["_" test (#+ Test)] - [control - pipe - [io (#+ IO)] - [concurrency - ["." atom]]] - [data - ["." error] - ["." product]] - ["." type ("#@." equivalence)] - [macro - ["." code]]] - [//// - [analysis - ["_." primitive]]] - {1 - ["." / - ["///#" //// - [analysis - ["#." scope] - ["#." type]]]]}) - -(template [ ] - [(def: ( procedure params output-type) - (-> Text (List Code) Type Bit) - (|> (////scope.with-scope "" - (////type.with-type output-type - (_primitive.phase (` ((~ (code.text procedure)) (~+ params)))))) - (////.run _primitive.state) - (case> (#error.Success _) - - - (#error.Failure error) - )))] - - [check-success+ true false] - [check-failure+ false true] - ) - -(def: primitive - (Random [Type Code]) - (r.filter (|>> product.left (is? Any) not) _primitive.primitive)) - -(def: lux - Test - (do r.monad - [[primT primC] ..primitive - [antiT antiC] (|> ..primitive - (r.filter (|>> product.left (type@= primT) not)))] - ($_ _.and - (_.test "Can test for reference equality." - (check-success+ "lux is" (list primC primC) Bit)) - (_.test "Reference equality must be done with elements of the same type." - (check-failure+ "lux is" (list primC antiC) Bit)) - (_.test "Can 'try' risky IO computations." - (check-success+ "lux try" - (list (` ("lux io error" "YOLO"))) - (type (Either Text primT)))) - ))) - -(def: i64 - Test - (do r.monad - [subjectC (|> r.nat (:: @ map code.nat)) - signedC (|> r.int (:: @ map code.int)) - paramC (|> r.nat (:: @ map code.nat))] - ($_ _.and - (_.test "i64 'and'." - (check-success+ "lux i64 and" (list paramC subjectC) Nat)) - (_.test "i64 'or'." - (check-success+ "lux i64 or" (list paramC subjectC) Nat)) - (_.test "i64 'xor'." - (check-success+ "lux i64 xor" (list paramC subjectC) Nat)) - (_.test "i64 left-shift." - (check-success+ "lux i64 left-shift" (list paramC subjectC) Nat)) - (_.test "i64 logical-right-shift." - (check-success+ "lux i64 logical-right-shift" (list paramC subjectC) Nat)) - (_.test "i64 arithmetic-right-shift." - (check-success+ "lux i64 arithmetic-right-shift" (list paramC signedC) Int)) - (_.test "i64 equivalence." - (check-success+ "lux i64 =" (list paramC subjectC) Bit)) - (_.test "i64 addition." - (check-success+ "lux i64 +" (list paramC subjectC) Int)) - (_.test "i64 subtraction." - (check-success+ "lux i64 -" (list paramC subjectC) Int)) - ))) - -(def: int - Test - (do r.monad - [subjectC (|> r.int (:: @ map code.int)) - paramC (|> r.int (:: @ map code.int))] - ($_ _.and - (_.test "Can multiply integers." - (check-success+ "lux i64 *" (list paramC subjectC) Int)) - (_.test "Can divide integers." - (check-success+ "lux i64 /" (list paramC subjectC) Int)) - (_.test "Can calculate remainder of integers." - (check-success+ "lux i64 %" (list paramC subjectC) Int)) - (_.test "Can compare integers." - (check-success+ "lux i64 <" (list paramC subjectC) Bit)) - (_.test "Can convert integer to text." - (check-success+ "lux i64 char" (list subjectC) Text)) - (_.test "Can convert integer to fraction." - (check-success+ "lux i64 f64" (list subjectC) Frac)) - ))) - -(def: frac - Test - (do r.monad - [subjectC (|> r.safe-frac (:: @ map code.frac)) - paramC (|> r.safe-frac (:: @ map code.frac)) - encodedC (|> r.safe-frac (:: @ map (|>> %f code.text)))] - ($_ _.and - (_.test "Can add frac numbers." - (check-success+ "lux f64 +" (list paramC subjectC) Frac)) - (_.test "Can subtract frac numbers." - (check-success+ "lux f64 -" (list paramC subjectC) Frac)) - (_.test "Can multiply frac numbers." - (check-success+ "lux f64 *" (list paramC subjectC) Frac)) - (_.test "Can divide frac numbers." - (check-success+ "lux f64 /" (list paramC subjectC) Frac)) - (_.test "Can calculate remainder of frac numbers." - (check-success+ "lux f64 %" (list paramC subjectC) Frac)) - (_.test "Can test equivalence of frac numbers." - (check-success+ "lux f64 =" (list paramC subjectC) Bit)) - (_.test "Can compare frac numbers." - (check-success+ "lux f64 <" (list paramC subjectC) Bit)) - (_.test "Can obtain minimum frac number." - (check-success+ "lux f64 min" (list) Frac)) - (_.test "Can obtain maximum frac number." - (check-success+ "lux f64 max" (list) Frac)) - (_.test "Can obtain smallest frac number." - (check-success+ "lux f64 smallest" (list) Frac)) - (_.test "Can convert frac number to integer." - (check-success+ "lux f64 i64" (list subjectC) Int)) - (_.test "Can convert frac number to text." - (check-success+ "lux f64 encode" (list subjectC) Text)) - (_.test "Can convert text to frac number." - (check-success+ "lux f64 decode" (list encodedC) (type (Maybe Frac)))) - ))) - -(def: text - Test - (do r.monad - [subjectC (|> (r.unicode 5) (:: @ map code.text)) - paramC (|> (r.unicode 5) (:: @ map code.text)) - replacementC (|> (r.unicode 5) (:: @ map code.text)) - fromC (|> r.nat (:: @ map code.nat)) - toC (|> r.nat (:: @ map code.nat))] - ($_ _.and - (_.test "Can test text equivalence." - (check-success+ "lux text =" (list paramC subjectC) Bit)) - (_.test "Compare texts in lexicographical order." - (check-success+ "lux text <" (list paramC subjectC) Bit)) - (_.test "Can concatenate one text to another." - (check-success+ "lux text concat" (list subjectC paramC) Text)) - (_.test "Can find the index of a piece of text inside a larger one that (may) contain it." - (check-success+ "lux text index" (list fromC paramC subjectC) (type (Maybe Nat)))) - (_.test "Can query the size/length of a text." - (check-success+ "lux text size" (list subjectC) Nat)) - (_.test "Can obtain the character code of a text at a given index." - (check-success+ "lux text char" (list fromC subjectC) Nat)) - (_.test "Can clip a piece of text between 2 indices." - (check-success+ "lux text clip" (list fromC toC subjectC) Text)) - ))) - -(def: io - Test - (do r.monad - [logC (|> (r.unicode 5) (:: @ map code.text)) - exitC (|> r.int (:: @ map code.int))] - ($_ _.and - (_.test "Can log messages to standard output." - (check-success+ "lux io log" (list logC) Any)) - (_.test "Can throw a run-time error." - (check-success+ "lux io error" (list logC) Nothing)) - (_.test "Can exit the program." - (check-success+ "lux io exit" (list exitC) Nothing)) - (_.test "Can query the current time (as milliseconds since epoch)." - (check-success+ "lux io current-time" (list) Int)) - ))) - -(def: #export test - Test - (<| (_.context (name.module (name-of /._))) - ($_ _.and - ..lux - ..i64 - ..int - ..frac - ..text - ..io - ))) diff --git a/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux b/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux new file mode 100644 index 000000000..e45656025 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux @@ -0,0 +1,201 @@ +(.module: + [lux (#- i64 int primitive) + [abstract ["." monad (#+ do)]] + [data + text/format + ["." name]] + ["r" math/random (#+ Random) ("#@." monad)] + ["_" test (#+ Test)] + [control + pipe + [io (#+ IO)] + [concurrency + ["." atom]]] + [data + ["." error] + ["." product]] + ["." type ("#@." equivalence)] + [macro + ["." code]]] + [//// + [analysis + ["_." primitive]]] + {1 + ["." / + ["///#" //// + [analysis + ["#." scope] + ["#." type]]]]}) + +(template [ ] + [(def: ( procedure params output-type) + (-> Text (List Code) Type Bit) + (|> (////scope.with-scope "" + (////type.with-type output-type + (_primitive.phase (` ((~ (code.text procedure)) (~+ params)))))) + (////.run _primitive.state) + (case> (#error.Success _) + + + (#error.Failure error) + )))] + + [check-success+ true false] + [check-failure+ false true] + ) + +(def: primitive + (Random [Type Code]) + (r.filter (|>> product.left (is? Any) not) _primitive.primitive)) + +(def: lux + Test + (do r.monad + [[primT primC] ..primitive + [antiT antiC] (|> ..primitive + (r.filter (|>> product.left (type@= primT) not)))] + ($_ _.and + (_.test "Can test for reference equality." + (check-success+ "lux is" (list primC primC) Bit)) + (_.test "Reference equality must be done with elements of the same type." + (check-failure+ "lux is" (list primC antiC) Bit)) + (_.test "Can 'try' risky IO computations." + (check-success+ "lux try" + (list (` ("lux io error" "YOLO"))) + (type (Either Text primT)))) + ))) + +(def: i64 + Test + (do r.monad + [subjectC (|> r.nat (:: @ map code.nat)) + signedC (|> r.int (:: @ map code.int)) + paramC (|> r.nat (:: @ map code.nat))] + ($_ _.and + (_.test "i64 'and'." + (check-success+ "lux i64 and" (list paramC subjectC) Nat)) + (_.test "i64 'or'." + (check-success+ "lux i64 or" (list paramC subjectC) Nat)) + (_.test "i64 'xor'." + (check-success+ "lux i64 xor" (list paramC subjectC) Nat)) + (_.test "i64 left-shift." + (check-success+ "lux i64 left-shift" (list paramC subjectC) Nat)) + (_.test "i64 logical-right-shift." + (check-success+ "lux i64 logical-right-shift" (list paramC subjectC) Nat)) + (_.test "i64 arithmetic-right-shift." + (check-success+ "lux i64 arithmetic-right-shift" (list paramC signedC) Int)) + (_.test "i64 equivalence." + (check-success+ "lux i64 =" (list paramC subjectC) Bit)) + (_.test "i64 addition." + (check-success+ "lux i64 +" (list paramC subjectC) Int)) + (_.test "i64 subtraction." + (check-success+ "lux i64 -" (list paramC subjectC) Int)) + ))) + +(def: int + Test + (do r.monad + [subjectC (|> r.int (:: @ map code.int)) + paramC (|> r.int (:: @ map code.int))] + ($_ _.and + (_.test "Can multiply integers." + (check-success+ "lux i64 *" (list paramC subjectC) Int)) + (_.test "Can divide integers." + (check-success+ "lux i64 /" (list paramC subjectC) Int)) + (_.test "Can calculate remainder of integers." + (check-success+ "lux i64 %" (list paramC subjectC) Int)) + (_.test "Can compare integers." + (check-success+ "lux i64 <" (list paramC subjectC) Bit)) + (_.test "Can convert integer to text." + (check-success+ "lux i64 char" (list subjectC) Text)) + (_.test "Can convert integer to fraction." + (check-success+ "lux i64 f64" (list subjectC) Frac)) + ))) + +(def: frac + Test + (do r.monad + [subjectC (|> r.safe-frac (:: @ map code.frac)) + paramC (|> r.safe-frac (:: @ map code.frac)) + encodedC (|> r.safe-frac (:: @ map (|>> %f code.text)))] + ($_ _.and + (_.test "Can add frac numbers." + (check-success+ "lux f64 +" (list paramC subjectC) Frac)) + (_.test "Can subtract frac numbers." + (check-success+ "lux f64 -" (list paramC subjectC) Frac)) + (_.test "Can multiply frac numbers." + (check-success+ "lux f64 *" (list paramC subjectC) Frac)) + (_.test "Can divide frac numbers." + (check-success+ "lux f64 /" (list paramC subjectC) Frac)) + (_.test "Can calculate remainder of frac numbers." + (check-success+ "lux f64 %" (list paramC subjectC) Frac)) + (_.test "Can test equivalence of frac numbers." + (check-success+ "lux f64 =" (list paramC subjectC) Bit)) + (_.test "Can compare frac numbers." + (check-success+ "lux f64 <" (list paramC subjectC) Bit)) + (_.test "Can obtain minimum frac number." + (check-success+ "lux f64 min" (list) Frac)) + (_.test "Can obtain maximum frac number." + (check-success+ "lux f64 max" (list) Frac)) + (_.test "Can obtain smallest frac number." + (check-success+ "lux f64 smallest" (list) Frac)) + (_.test "Can convert frac number to integer." + (check-success+ "lux f64 i64" (list subjectC) Int)) + (_.test "Can convert frac number to text." + (check-success+ "lux f64 encode" (list subjectC) Text)) + (_.test "Can convert text to frac number." + (check-success+ "lux f64 decode" (list encodedC) (type (Maybe Frac)))) + ))) + +(def: text + Test + (do r.monad + [subjectC (|> (r.unicode 5) (:: @ map code.text)) + paramC (|> (r.unicode 5) (:: @ map code.text)) + replacementC (|> (r.unicode 5) (:: @ map code.text)) + fromC (|> r.nat (:: @ map code.nat)) + toC (|> r.nat (:: @ map code.nat))] + ($_ _.and + (_.test "Can test text equivalence." + (check-success+ "lux text =" (list paramC subjectC) Bit)) + (_.test "Compare texts in lexicographical order." + (check-success+ "lux text <" (list paramC subjectC) Bit)) + (_.test "Can concatenate one text to another." + (check-success+ "lux text concat" (list subjectC paramC) Text)) + (_.test "Can find the index of a piece of text inside a larger one that (may) contain it." + (check-success+ "lux text index" (list fromC paramC subjectC) (type (Maybe Nat)))) + (_.test "Can query the size/length of a text." + (check-success+ "lux text size" (list subjectC) Nat)) + (_.test "Can obtain the character code of a text at a given index." + (check-success+ "lux text char" (list fromC subjectC) Nat)) + (_.test "Can clip a piece of text between 2 indices." + (check-success+ "lux text clip" (list fromC toC subjectC) Text)) + ))) + +(def: io + Test + (do r.monad + [logC (|> (r.unicode 5) (:: @ map code.text)) + exitC (|> r.int (:: @ map code.int))] + ($_ _.and + (_.test "Can log messages to standard output." + (check-success+ "lux io log" (list logC) Any)) + (_.test "Can throw a run-time error." + (check-success+ "lux io error" (list logC) Nothing)) + (_.test "Can exit the program." + (check-success+ "lux io exit" (list exitC) Nothing)) + (_.test "Can query the current time (as milliseconds since epoch)." + (check-success+ "lux io current-time" (list) Int)) + ))) + +(def: #export test + Test + (<| (_.context (name.module (name-of /._))) + ($_ _.and + ..lux + ..i64 + ..int + ..frac + ..text + ..io + ))) -- cgit v1.2.3