diff options
| author | Eduardo Julian | 2022-06-30 13:26:43 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2022-06-30 13:26:43 -0400 |
| commit | e853e9340d41724a86c9c0a837d86b2764bfcbab (patch) | |
| tree | 1ea4cf881ef6ce6ab38b7ab556106be760a3c8d4 /stdlib | |
| parent | 664e02d1b5e5aa479869c4e17ec4128f5cfd04e2 (diff) | |
Better naming for measure/quantity types.
Diffstat (limited to 'stdlib')
21 files changed, 3029 insertions, 3223 deletions
diff --git a/stdlib/source/documentation/lux/debug.lux b/stdlib/source/documentation/lux/debug.lux index 5a60f7012..b560b35fe 100644 --- a/stdlib/source/documentation/lux/debug.lux +++ b/stdlib/source/documentation/lux/debug.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except private) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,71 +10,65 @@ [\\library ["[0]" /]]) -(documentation: /.inspection - "A best-effort attempt to generate a textual representation of a value, without knowing its type." - [(inspection value)]) +(.def .public documentation + (.List $.Module) + ($.module /._ + "" + [($.default /.cannot_represent_value) + ($.default /.type_hole) + ($.default /.unknown_local_binding) -(documentation: /.representation - "A best-effort attempt to generate a textual representation of a value, while knowing its type." - [(representation type value)]) + ($.documentation /.inspection + "A best-effort attempt to generate a textual representation of a value, without knowing its type." + [(inspection value)]) -(documentation: /.private - "Allows access to un-exported definitions in other modules." - ["Module A" - (def .private (secret_definition input) - (-> ??? ???) - (foo (bar (baz input)))) - "Module B" - ((/.private secret_definition) my_input)]) + ($.documentation /.representation + "A best-effort attempt to generate a textual representation of a value, while knowing its type." + [(representation type value)]) -(documentation: /.log! - "Prints/writes a message to standard output." - [(log! message)]) + ($.documentation /.private + "Allows access to un-exported definitions in other modules." + ["Module A" + (def .private (secret_definition input) + (-> ??? ???) + (foo (bar (baz input)))) + "Module B" + ((/.private secret_definition) my_input)]) -(documentation: /.hole - (format "A typed 'hole'." - \n "Reveals the type expected of the expression that should go in the hole.") - [(is (-> Nat Text) - (function (_ number) - (hole))) - "=>" - .Text]) + ($.documentation /.log! + "Prints/writes a message to standard output." + [(log! message)]) -(documentation: /.here - "Shows the names and values of local bindings available around the call to 'here'." - [(let [foo 123 - bar +456 - baz +789.0] - (is Any - (here))) - "=>" - "foo: +123" - "bar: +456" - "baz: +789.0" - []] - ["Can optionally be given a list of definitions to focus on." - "These definitions to focus on can include custom format to represent the values." - (let [foo 123 - bar +456 - baz +789.0] - (is Any - (here [foo %.nat] baz))) - "=>" - "foo: 123" - "baz: +789.0" - []]) + ($.documentation /.hole + (format "A typed 'hole'." + \n "Reveals the type expected of the expression that should go in the hole.") + [(is (-> Nat Text) + (function (_ number) + (hole))) + "=>" + .Text]) -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [..inspection - ..representation - ..private - ..log! - ..hole - ..here - ($.default /.cannot_represent_value) - ($.default /.type_hole) - ($.default /.unknown_local_binding)] + ($.documentation /.here + "Shows the names and values of local bindings available around the call to 'here'." + [(let [foo 123 + bar +456 + baz +789.0] + (is Any + (here))) + "=>" + "foo: +123" + "bar: +456" + "baz: +789.0" + []] + ["Can optionally be given a list of definitions to focus on." + "These definitions to focus on can include custom format to represent the values." + (let [foo 123 + bar +456 + baz +789.0] + (is Any + (here [foo %.nat] baz))) + "=>" + "foo: 123" + "baz: +789.0" + []])] [])) diff --git a/stdlib/source/documentation/lux/documentation.lux b/stdlib/source/documentation/lux/documentation.lux index c720ae97a..bdebfab7e 100644 --- a/stdlib/source/documentation/lux/documentation.lux +++ b/stdlib/source/documentation/lux/documentation.lux @@ -9,41 +9,31 @@ [\\library ["[0]" /]]) -(/.documentation: /.default - "" - [(is /.Definition - (default ..definition))]) +(with_expansions [<default> (/.documentation /.default + "" + [(is /.Definition + (default ..definition))]) + <documentation> (/.documentation /.documentation + "" + [<default>]) + <all> (these (/.default /.unqualified_symbol) + (/.default /.Definition) + (/.default /.Module) + (/.default /.documentation) -(/.documentation: /.documentation: - "" - [(documentation: /.default - "" - [(is /.Definition - (default ..definition))])]) + <default> + <documentation>)] + (.def .public documentation + (.List /.Module) + (/.module /._ + "" + [<all> -(/.documentation: /.module - "" - [(is (.List /.Module) - (module /._ - "" - [..default - ..documentation: - ..module - (/.default /.unqualified_symbol) - (/.default /.Definition) - (/.default /.Module) - (/.default /.documentation)] - []))]) - -(.def .public documentation - (.List /.Module) - (/.module /._ - "" - [..default - ..documentation: - ..module - (/.default /.unqualified_symbol) - (/.default /.Definition) - (/.default /.Module) - (/.default /.documentation)] - [])) + (/.documentation /.module + "" + [(is (.List /.Module) + (module /._ + "" + [<all>] + []))])] + []))) diff --git a/stdlib/source/documentation/lux/extension.lux b/stdlib/source/documentation/lux/extension.lux index 5dd79df31..729abbec5 100644 --- a/stdlib/source/documentation/lux/extension.lux +++ b/stdlib/source/documentation/lux/extension.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - ["$" documentation (.only documentation:)] + ["$" documentation] ["[0]" debug] [data [text @@ -12,8 +12,6 @@ ["[0]" template] ["[0]" code ["<[1]>" \\parser]]] - ["@" target - ["[0]" jvm]] [tool [compiler ["[0]" phase] @@ -24,38 +22,29 @@ [\\library ["[0]" /]]) -(documentation: /.analysis - "Mechanism for defining extensions to Lux's analysis/type-checking infrastructure." - [(analysis ("my analysis" self phase archive [pass_through <code>.any]) - (phase archive pass_through))]) - -(documentation: /.synthesis - "Mechanism for defining extensions to Lux's synthesis/optimization infrastructure." - [(synthesis ("my synthesis" self phase archive [pass_through <analysis>.any]) - (phase archive pass_through))]) - -(documentation: /.generation - "" - [(generation ("my generation" self phase archive [pass_through <synthesis>.any]) - (for @.jvm - (at phase.monad each (|>> {jvm.#Embedded} - sequence.sequence) - (phase archive pass_through)) - (phase archive pass_through)))]) - -(documentation: /.declaration - "" - [(declaration ("my declaration" self phase archive [parameters (<>.some <code>.any)]) - (do phase.monad - [.let [_ (debug.log! (format "Successfully installed declaration " (%.text self) "!"))]] - (in declaration.no_requirements)))]) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..analysis - ..synthesis - ..generation - ..declaration] + [($.documentation /.analysis + "Mechanism for defining extensions to Lux's analysis/type-checking infrastructure." + [(analysis ("my analysis" self phase archive [pass_through <code>.any]) + (phase archive pass_through))]) + + ($.documentation /.synthesis + "Mechanism for defining extensions to Lux's synthesis/optimization infrastructure." + [(synthesis ("my synthesis" self phase archive [pass_through <analysis>.any]) + (phase archive pass_through))]) + + ($.documentation /.generation + "" + [(generation ("my generation" self phase archive [pass_through <synthesis>.any]) + (phase archive pass_through))]) + + ($.documentation /.declaration + "" + [(declaration ("my declaration" self phase archive [parameters (<>.some <code>.any)]) + (do phase.monad + [.let [_ (debug.log! (format "Successfully installed declaration " (%.text self) "!"))]] + (in declaration.no_requirements)))])] [])) diff --git a/stdlib/source/documentation/lux/ffi.js.lux b/stdlib/source/documentation/lux/ffi.js.lux index 6797208c8..71bf8062d 100644 --- a/stdlib/source/documentation/lux/ffi.js.lux +++ b/stdlib/source/documentation/lux/ffi.js.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except int char) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,56 +10,11 @@ [\\library ["[0]" /]]) -(documentation: /.null - "The null pointer.") - -(documentation: /.import - "Easily import types, methods, functions and constants." - [(import Uint8Array - "[1]::[0]") - - (import TextEncoder - "[1]::[0]" - (new [/.String]) - (encode [/.String] Uint8Array)) - - (import TextDecoder - "[1]::[0]" - (new [/.String]) - (decode [/.String] String))]) - -(documentation: /.type_of - "The type of an object, as text." - [(= "boolean" - (type_of #1))] - [(= "number" - (type_of +123.456))] - [(= "string" - (type_of "789"))] - [(= "function" - (type_of (function (_ value) value)))]) - -(documentation: /.constant - "Allows using definitions from the JavaScript host platform." - [(constant .Frac [Math PI])]) - -(documentation: /.closure - (format "Allows defining closures/anonymous-functions in the form that JavaScript expects." - \n "This is useful for adapting Lux functions for usage by JavaScript code.") - [(is /.Function - (closure [left right] - (do_something (as Foo left) (as Bar right))))]) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..null - ..import - ..type_of - ..constant - ..closure - ($.default (/.Object brand)) + [($.default (/.Object brand)) ($.default /.Function) ($.default /.Symbol) ($.default /.Null) @@ -70,5 +25,45 @@ ($.default /.null?) ($.default /.on_browser?) ($.default /.on_nashorn?) - ($.default /.on_node_js?)] + ($.default /.on_node_js?) + + ($.documentation /.null + "The null pointer.") + + ($.documentation /.import + "Easily import types, methods, functions and constants." + [(import Uint8Array + "[1]::[0]") + + (import TextEncoder + "[1]::[0]" + (new [/.String]) + (encode [/.String] Uint8Array)) + + (import TextDecoder + "[1]::[0]" + (new [/.String]) + (decode [/.String] String))]) + + ($.documentation /.type_of + "The type of an object, as text." + [(= "boolean" + (type_of #1))] + [(= "number" + (type_of +123.456))] + [(= "string" + (type_of "789"))] + [(= "function" + (type_of (function (_ value) value)))]) + + ($.documentation /.constant + "Allows using definitions from the JavaScript host platform." + [(constant .Frac [Math PI])]) + + ($.documentation /.closure + (format "Allows defining closures/anonymous-functions in the form that JavaScript expects." + \n "This is useful for adapting Lux functions for usage by JavaScript code.") + [(is /.Function + (closure [left right] + (do_something (as Foo left) (as Bar right))))])] [])) diff --git a/stdlib/source/documentation/lux/ffi.jvm.lux b/stdlib/source/documentation/lux/ffi.jvm.lux index da10cb3d6..436c252b6 100644 --- a/stdlib/source/documentation/lux/ffi.jvm.lux +++ b/stdlib/source/documentation/lux/ffi.jvm.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except int char is as) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,324 +10,259 @@ [\\library ["[0]" /]]) -(with_template [<name>] - [(`` (documentation: <name> - (format "The type of a (boxed) " (~~ (template.text [<name>])) " object.")))] - - [/.Boolean] - [/.Byte] - [/.Short] - [/.Integer] - [/.Long] - [/.Float] - [/.Double] - [/.Character] - ) - -(with_template [<name>] - [(`` (documentation: <name> - (format "The type of an (unboxed) " (~~ (template.text [<name>])) " value.")))] - - [/.boolean] - [/.byte] - [/.short] - [/.int] - [/.long] - [/.float] - [/.double] - [/.char] - ) - -(with_template [<name> <from> <to>] - [(`` (documentation: <name> - "Type converter."))] - - [/.byte_to_long Byte Long] - - [/.short_to_long Short Long] - - [/.double_to_int Double Integer] - [/.double_to_long Double Long] - [/.double_to_float Double Float] - - [/.float_to_int Float Integer] - [/.float_to_long Float Long] - [/.float_to_double Float Double] - - [/.int_to_byte Integer Byte] - [/.int_to_short Integer Short] - [/.int_to_long Integer Long] - [/.int_to_float Integer Float] - [/.int_to_double Integer Double] - [/.int_to_char Integer Character] - - [/.long_to_byte Long Byte] - [/.long_to_short Long Short] - [/.long_to_int Long Integer] - [/.long_to_float Long Float] - [/.long_to_double Long Double] - - [/.char_to_byte Character Byte] - [/.char_to_short Character Short] - [/.char_to_int Character Integer] - [/.char_to_long Character Long] - - [/.long_to_char Long Character] - [/.byte_to_int Byte Integer] - [/.short_to_int Short Integer] - [/.byte_to_char Byte Character] - [/.short_to_char Short Character] - ) - -(documentation: /.class - "Allows defining JVM classes in Lux code." - [(class "final" (TestClass A) [Runnable] - ... Fields - ("private" foo boolean) - ("private" bar A) - ("private" baz java/lang/Object) - ... Methods - ("public" [] (new [value A]) [] - (exec - (:= ::foo #1) - (:= ::bar value) - (:= ::baz "") - [])) - ("public" (virtual) java/lang/Object - "") - ("public" "static" (static) java/lang/Object - "") - (Runnable [] (run) void - []) - ) - - "The tuple corresponds to parent interfaces." - "An optional super-class can be specified before the tuple. If not specified, java.lang.Object will be assumed." - "Fields and methods defined in the class can be used with special syntax." - "For example:" - "::resolved, for accessing the 'resolved' field." - "(:= ::resolved #1) for modifying it." - "(::new! []) for calling the class's constructor." - "(::resolve! container [value]) for calling the 'resolve' method."]) - -(documentation: /.interface - "Allows defining JVM interfaces." - [(interface TestInterface - ([] foo [boolean String] void "throws" [Exception]))]) - -(documentation: /.object - "Allows defining anonymous classes." - ["The 1st tuple corresponds to class-level type-variables." - "The 2nd tuple corresponds to parent interfaces." - "The 3rd tuple corresponds to arguments to the super class constructor." - "An optional super-class can be specified before the 1st tuple. If not specified, java.lang.Object will be assumed." - (object [] [Runnable] - [] - (Runnable [] (run self) void - (exec - (do_something some_value) - [])))]) - -(documentation: /.null - "The null pointer." - [(null)]) - -(documentation: /.null? - "Test for the null pointer." - [(= true - (null? (null)))] - [(= false - (null? "YOLO"))]) - -(documentation: /.??? - "Takes a (potentially null) ObjectType reference and creates a (Maybe ObjectType) for it." - [(= (??? (is java/lang/String (null))) - {.#None})] - [(= (??? "YOLO") - {.#Some "YOLO"})]) - -(documentation: /.!!! - (format "Takes a (Maybe ObjectType) and returns a ObjectType." - \n "A .#None would get translated into a (null).") - [(= (null) - (!!! (??? (is java/lang/Thread (null)))))] - [(= "foo" - (!!! (??? "foo")))]) - -(documentation: /.as - (format "Checks whether an object is an instance of a particular class." - \n "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes.") - [(case (as String "YOLO") - {.#Some value_as_string} - {.#None})]) - -(documentation: /.synchronized - "Evaluates body, while holding a lock on a given object." - [(synchronized object_to_be_locked - (exec - (do something) - (dosomething else) - (finish the computation)))]) - -(documentation: /.do_to - "Call a variety of methods on an object. Then, return the object." - [(do_to object - (ClassName::method1 arg0 arg1 arg2) - (ClassName::method2 arg3 arg4 arg5))]) - -(documentation: /.import - "Allows importing JVM classes, and using them as types." - ["Their methods, fields and enum options can also be imported." - (import java/lang/Object - "[1]::[0]" - (new []) - (equals [java/lang/Object] boolean) - (wait [int] "io" "try" void))] - ["Special options can also be given for the return values." - "'?' means that the values will be returned inside a Maybe type. That way, null becomes .#None." - "'try' means that the computation might throw an exception, and the return value will be wrapped by the Try type." - "'io' means the computation has side effects, and will be wrapped by the IO type." - "These options must show up in the following order ['io' 'try' '?'] (although, each option can be used independently)." - (import java/lang/String - "[1]::[0]" - (new [[byte]]) - ("static" valueOf [char] java/lang/String) - ("static" valueOf "as" int_valueOf [int] java/lang/String)) - - (import (java/util/List e) - "[1]::[0]" - (size [] int) - (get [int] e)) - - (import (java/util/ArrayList a) - "[1]::[0]" - ([T] toArray [[T]] [T]))] - ["The class-type that is generated is of the fully-qualified name." - "This avoids a clash between the java.util.List type, and Lux's own List type." - "All enum options to be imported must be specified." - (import java/lang/Character$UnicodeScript - "[1]::[0]" - ("enum" ARABIC CYRILLIC LATIN))] - ["It should also be noted, the only types that may show up in method arguments or return values may be Java classes, arrays, primitives, void or type-vars." - "Lux types, such as Maybe cannot be named (otherwise, they'd be confused for Java classes)." - (import (lux/concurrency/async/JvmAsync A) - "[1]::[0]" - (resolve [A] boolean) - (poll [] A) - (wasResolved [] boolean) - (waitOn [lux/Function] void) - ("static" [A] make [A] (lux/concurrency/async/JvmAsync A)))] - ["Also, the names of the imported members will look like Class::member" - (java/lang/Object::new []) - (java/lang/Object::equals [other_object] my_object) - (java/util/List::size [] my_list) - java/lang/Character$UnicodeScript::LATIN]) - -(documentation: /.array - "Create an array of the given type, with the given size." - [(array java/lang/Object 10)]) - -(documentation: /.length - "Gives the length of an array." - [(length my_array)]) - -(documentation: /.read! - "Loads an element from an array." - [(read! 10 my_array)]) - -(documentation: /.write! - "Stores an element into an array." - [(write! 10 my_object my_array)]) - -(documentation: /.class_for - "Loads the class as a java.lang.Class object." - [(class_for java/lang/String)]) - -(documentation: /.type - "" - [(is Type - (type java/lang/String))]) - -(documentation: /.is - "" - [(is java/lang/Object - (is java/lang/String - ???))]) - -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [..Boolean - ..Byte - ..Short - ..Integer - ..Long - ..Float - ..Double - ..Character - - ..boolean - ..byte - ..short - ..int - ..long - ..float - ..double - ..char - - ..byte_to_long - ..short_to_long - ..double_to_int - ..double_to_long - ..double_to_float - ..float_to_int - ..float_to_long - ..float_to_double - ..int_to_byte - ..int_to_short - ..int_to_long - ..int_to_float - ..int_to_double - ..int_to_char - ..long_to_byte - ..long_to_short - ..long_to_int - ..long_to_float - ..long_to_double - ..char_to_byte - ..char_to_short - ..char_to_int - ..char_to_long - ..long_to_char - ..byte_to_int - ..short_to_int - ..byte_to_char - ..short_to_char - - ..class - ..interface - ..object - ..null - ..null? - ..??? - ..!!! - ..as - ..synchronized - ..do_to - ..import - ..array - ..length - ..read! - ..write! - ..class_for - ..type - ..is - ($.default /.Privacy) - ($.default /.State) - ($.default /.Inheritance) - ($.default /.class_names_cannot_contain_periods) - ($.default /.class_name_cannot_be_a_type_variable) - ($.default /.cannot_convert_to_jvm_type) - ($.default /.cannot_cast_to_non_object)] - [])) +(`` (.def .public documentation + (.List $.Module) + ($.module /._ + "" + [($.default /.Privacy) + ($.default /.State) + ($.default /.Inheritance) + ($.default /.class_names_cannot_contain_periods) + ($.default /.class_name_cannot_be_a_type_variable) + ($.default /.cannot_convert_to_jvm_type) + ($.default /.cannot_cast_to_non_object) + + (~~ (with_template [<name>] + [(`` ($.documentation <name> + (format "The type of a (boxed) " (~~ (template.text [<name>])) " object.")))] + + [/.Boolean] + [/.Byte] + [/.Short] + [/.Integer] + [/.Long] + [/.Float] + [/.Double] + [/.Character] + )) + + (~~ (with_template [<name>] + [(`` ($.documentation <name> + (format "The type of an (unboxed) " (~~ (template.text [<name>])) " value.")))] + + [/.boolean] + [/.byte] + [/.short] + [/.int] + [/.long] + [/.float] + [/.double] + [/.char] + )) + + (~~ (with_template [<name> <from> <to>] + [(`` ($.documentation <name> + "Type converter."))] + + [/.byte_to_long Byte Long] + + [/.short_to_long Short Long] + + [/.double_to_int Double Integer] + [/.double_to_long Double Long] + [/.double_to_float Double Float] + + [/.float_to_int Float Integer] + [/.float_to_long Float Long] + [/.float_to_double Float Double] + + [/.int_to_byte Integer Byte] + [/.int_to_short Integer Short] + [/.int_to_long Integer Long] + [/.int_to_float Integer Float] + [/.int_to_double Integer Double] + [/.int_to_char Integer Character] + + [/.long_to_byte Long Byte] + [/.long_to_short Long Short] + [/.long_to_int Long Integer] + [/.long_to_float Long Float] + [/.long_to_double Long Double] + + [/.char_to_byte Character Byte] + [/.char_to_short Character Short] + [/.char_to_int Character Integer] + [/.char_to_long Character Long] + + [/.long_to_char Long Character] + [/.byte_to_int Byte Integer] + [/.short_to_int Short Integer] + [/.byte_to_char Byte Character] + [/.short_to_char Short Character] + )) + + ($.documentation /.class + "Allows defining JVM classes in Lux code." + [(class "final" (TestClass A) [Runnable] + ... Fields + ("private" foo boolean) + ("private" bar A) + ("private" baz java/lang/Object) + ... Methods + ("public" [] (new [value A]) [] + (exec + (:= ::foo #1) + (:= ::bar value) + (:= ::baz "") + [])) + ("public" (virtual) java/lang/Object + "") + ("public" "static" (static) java/lang/Object + "") + (Runnable [] (run) void + []) + ) + + "The tuple corresponds to parent interfaces." + "An optional super-class can be specified before the tuple. If not specified, java.lang.Object will be assumed." + "Fields and methods defined in the class can be used with special syntax." + "For example:" + "::resolved, for accessing the 'resolved' field." + "(:= ::resolved #1) for modifying it." + "(::new! []) for calling the class's constructor." + "(::resolve! container [value]) for calling the 'resolve' method."]) + + ($.documentation /.interface + "Allows defining JVM interfaces." + [(interface TestInterface + ([] foo [boolean String] void "throws" [Exception]))]) + + ($.documentation /.object + "Allows defining anonymous classes." + ["The 1st tuple corresponds to class-level type-variables." + "The 2nd tuple corresponds to parent interfaces." + "The 3rd tuple corresponds to arguments to the super class constructor." + "An optional super-class can be specified before the 1st tuple. If not specified, java.lang.Object will be assumed." + (object [] [Runnable] + [] + (Runnable [] (run self) void + (exec + (do_something some_value) + [])))]) + + ($.documentation /.null + "The null pointer." + [(null)]) + + ($.documentation /.null? + "Test for the null pointer." + [(= true + (null? (null)))] + [(= false + (null? "YOLO"))]) + + ($.documentation /.??? + "Takes a (potentially null) ObjectType reference and creates a (Maybe ObjectType) for it." + [(= (??? (is java/lang/String (null))) + {.#None})] + [(= (??? "YOLO") + {.#Some "YOLO"})]) + + ($.documentation /.!!! + (format "Takes a (Maybe ObjectType) and returns a ObjectType." + \n "A .#None would get translated into a (null).") + [(= (null) + (!!! (??? (is java/lang/Thread (null)))))] + [(= "foo" + (!!! (??? "foo")))]) + + ($.documentation /.as + (format "Checks whether an object is an instance of a particular class." + \n "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes.") + [(case (as String "YOLO") + {.#Some value_as_string} + {.#None})]) + + ($.documentation /.synchronized + "Evaluates body, while holding a lock on a given object." + [(synchronized object_to_be_locked + (exec + (do something) + (dosomething else) + (finish the computation)))]) + + ($.documentation /.do_to + "Call a variety of methods on an object. Then, return the object." + [(do_to object + (ClassName::method1 arg0 arg1 arg2) + (ClassName::method2 arg3 arg4 arg5))]) + + ($.documentation /.import + "Allows importing JVM classes, and using them as types." + ["Their methods, fields and enum options can also be imported." + (import java/lang/Object + "[1]::[0]" + (new []) + (equals [java/lang/Object] boolean) + (wait [int] "io" "try" void))] + ["Special options can also be given for the return values." + "'?' means that the values will be returned inside a Maybe type. That way, null becomes .#None." + "'try' means that the computation might throw an exception, and the return value will be wrapped by the Try type." + "'io' means the computation has side effects, and will be wrapped by the IO type." + "These options must show up in the following order ['io' 'try' '?'] (although, each option can be used independently)." + (import java/lang/String + "[1]::[0]" + (new [[byte]]) + ("static" valueOf [char] java/lang/String) + ("static" valueOf "as" int_valueOf [int] java/lang/String)) + + (import (java/util/List e) + "[1]::[0]" + (size [] int) + (get [int] e)) + + (import (java/util/ArrayList a) + "[1]::[0]" + ([T] toArray [[T]] [T]))] + ["The class-type that is generated is of the fully-qualified name." + "This avoids a clash between the java.util.List type, and Lux's own List type." + "All enum options to be imported must be specified." + (import java/lang/Character$UnicodeScript + "[1]::[0]" + ("enum" ARABIC CYRILLIC LATIN))] + ["It should also be noted, the only types that may show up in method arguments or return values may be Java classes, arrays, primitives, void or type-vars." + "Lux types, such as Maybe cannot be named (otherwise, they'd be confused for Java classes)." + (import (lux/concurrency/async/JvmAsync A) + "[1]::[0]" + (resolve [A] boolean) + (poll [] A) + (wasResolved [] boolean) + (waitOn [lux/Function] void) + ("static" [A] make [A] (lux/concurrency/async/JvmAsync A)))] + ["Also, the names of the imported members will look like Class::member" + (java/lang/Object::new []) + (java/lang/Object::equals [other_object] my_object) + (java/util/List::size [] my_list) + java/lang/Character$UnicodeScript::LATIN]) + + ($.documentation /.array + "Create an array of the given type, with the given size." + [(array java/lang/Object 10)]) + + ($.documentation /.length + "Gives the length of an array." + [(length my_array)]) + + ($.documentation /.read! + "Loads an element from an array." + [(read! 10 my_array)]) + + ($.documentation /.write! + "Stores an element into an array." + [(write! 10 my_object my_array)]) + + ($.documentation /.class_for + "Loads the class as a java.lang.Class object." + [(class_for java/lang/String)]) + + ($.documentation /.type + "" + [(is Type + (type java/lang/String))]) + + ($.documentation /.is + "" + [(is java/lang/Object + (is java/lang/String + ???))])] + []))) diff --git a/stdlib/source/documentation/lux/ffi.lua.lux b/stdlib/source/documentation/lux/ffi.lua.lux index 5edd5c9e0..4b5e478de 100644 --- a/stdlib/source/documentation/lux/ffi.lua.lux +++ b/stdlib/source/documentation/lux/ffi.lua.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except int char) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,29 +10,27 @@ [\\library ["[0]" /]]) -(documentation: /.import - "Easily import types, methods, functions and constants." - [(import (os/getenv [..String] "io" "?" ..String))]) - -(documentation: /.closure - (format "Allows defining closures/anonymous-functions in the form that Lua expects." - \n "This is useful for adapting Lux functions for usage by Lua code.") - [(is ..Function - (closure [left right] - (do_something (as Foo left) (as Bar right))))]) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..import - ..closure - ($.default (/.Object brand)) + [($.default (/.Object brand)) ($.default /.Nil) ($.default /.Function) ($.default /.Table) ($.default /.Boolean) ($.default /.Integer) ($.default /.Float) - ($.default /.String)] + ($.default /.String) + + ($.documentation /.import + "Easily import types, methods, functions and constants." + [(import (os/getenv [..String] "io" "?" ..String))]) + + ($.documentation /.closure + (format "Allows defining closures/anonymous-functions in the form that Lua expects." + \n "This is useful for adapting Lux functions for usage by Lua code.") + [(is ..Function + (closure [left right] + (do_something (as Foo left) (as Bar right))))])] [])) diff --git a/stdlib/source/documentation/lux/ffi.old.lux b/stdlib/source/documentation/lux/ffi.old.lux index 805f9ec8c..460e8512e 100644 --- a/stdlib/source/documentation/lux/ffi.old.lux +++ b/stdlib/source/documentation/lux/ffi.old.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except int char) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,253 +10,213 @@ [\\library ["[0]" /]]) -(with_template [<name> <from> <to>] - [(documentation: <name> - "Type converter.")] - - [/.byte_to_long "java.lang.Byte" "java.lang.Long"] - - [/.short_to_long "java.lang.Short" "java.lang.Long"] - - [/.double_to_int "java.lang.Double" "java.lang.Integer"] - [/.double_to_long "java.lang.Double" "java.lang.Long"] - [/.double_to_float "java.lang.Double" "java.lang.Float"] - - [/.float_to_int "java.lang.Float" "java.lang.Integer"] - [/.float_to_long "java.lang.Float" "java.lang.Long"] - [/.float_to_double "java.lang.Float" "java.lang.Double"] - - [/.int_to_byte "java.lang.Integer" "java.lang.Byte"] - [/.int_to_short "java.lang.Integer" "java.lang.Short"] - [/.int_to_long "java.lang.Integer" "java.lang.Long"] - [/.int_to_float "java.lang.Integer" "java.lang.Float"] - [/.int_to_double "java.lang.Integer" "java.lang.Double"] - [/.int_to_char "java.lang.Integer" "java.lang.Character"] - - [/.long_to_byte "java.lang.Long" "java.lang.Byte"] - [/.long_to_short "java.lang.Long" "java.lang.Short"] - [/.long_to_int "java.lang.Long" "java.lang.Integer"] - [/.long_to_float "java.lang.Long" "java.lang.Float"] - [/.long_to_double "java.lang.Long" "java.lang.Double"] - - [/.char_to_byte "java.lang.Character" "java.lang.Byte"] - [/.char_to_short "java.lang.Character" "java.lang.Short"] - [/.char_to_int "java.lang.Character" "java.lang.Integer"] - [/.char_to_long "java.lang.Character" "java.lang.Long"] - ) - -(documentation: /.class - "Allows defining JVM classes in Lux code." - [(class "final" (TestClass A) [Runnable] - ... Fields - ("private" foo boolean) - ("private" bar A) - ("private" baz java/lang/Object) - ... Methods - ("public" [] (new [value A]) [] - (exec - (:= ::foo #1) - (:= ::bar value) - (:= ::baz "") - [])) - ("public" (virtual) java/lang/Object - "") - ("public" "static" (static) java/lang/Object - "") - (Runnable [] (run) void - [])) - "The tuple corresponds to parent interfaces." - "An optional super-class can be specified before the tuple. If not specified, java.lang.Object will be assumed." - "Fields and methods defined in the class can be used with special syntax." - "For example:" - "::resolved, for accessing the 'resolved' field." - "(:= ::resolved #1) for modifying it." - "(::new! []) for calling the class's constructor." - "(::resolve! container [value]) for calling the 'resolve' method."]) - -(documentation: /.interface - "Allows defining JVM interfaces." - [(interface TestInterface - ([] foo [boolean String] void "throws" [Exception]))]) - -(documentation: /.object - "Allows defining anonymous classes." - ["The 1st tuple corresponds to class-level type-variables." - "The 2nd tuple corresponds to parent interfaces." - "The 3rd tuple corresponds to arguments to the super class constructor." - "An optional super-class can be specified before the 1st tuple. If not specified, java.lang.Object will be assumed." - (object [] [Runnable] - [] - (Runnable [] (run self) void - (exec (do_something some_value) - [])))]) - -(documentation: /.null - "Null object reference." - (null)) - -(documentation: /.null? - "Test for null object reference." - [(= (null? (null)) - true)] - [(= (null? "YOLO") - false)]) - -(documentation: /.??? - "Takes a (potentially null) ObjectType reference and creates a (Maybe ObjectType) for it." - [(= (??? (is java/lang/String (null))) - {.#None})] - [(= (??? "YOLO") - {.#Some "YOLO"})]) - -(documentation: /.!!! - "Takes a (Maybe ObjectType) and returns a ObjectType." - [(= "foo" - (!!! (??? "foo")))] - ["A .#None would get translated into a (null)." - (= (null) - (!!! (??? (is java/lang/Thread (null)))))]) - -(documentation: /.check - (format "Checks whether an object is an instance of a particular class." - \n "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes.") - [(case (check java/lang/String "YOLO") - {.#Some value_as_string} - {.#None})]) - -(documentation: /.synchronized - "Evaluates body, while holding a lock on a given object." - [(synchronized object_to_be_locked - (exec - (do something) - (do_something else) - (finish the computation)))]) - -(documentation: /.do_to - "Call a variety of methods on an object. Then, return the object." - [(do_to object - (ClassName::method0 arg0 arg1 arg2) - (ClassName::method1 arg3 arg4 arg5))]) - -(documentation: /.import - (format "Allows importing JVM classes, and using them as types." - \n "Their methods, fields and enum options can also be imported.") - [(import java/lang/Object - "[1]::[0]" - (new []) - (equals [java/lang/Object] boolean) - (wait [int] "io" "try" void))] - ["Special options can also be given for the return values." - "'?' means that the values will be returned inside a Maybe type. That way, null becomes .#None." - "'try' means that the computation might throw an exception, and the return value will be wrapped by the Try type." - "'io' means the computation has side effects, and will be wrapped by the IO type." - "These options must show up in the following order ['io' 'try' '?'] (although, each option can be used independently)." - (import java/lang/String - "[1]::[0]" - (new [[byte]]) - ("static" valueOf [char] java/lang/String) - ("static" valueOf "as" int_valueOf [int] java/lang/String)) - - (import (java/util/List e) - "[1]::[0]" - (size [] int) - (get [int] e)) - - (import (java/util/ArrayList a) - "[1]::[0]" - ([T] toArray [[T]] [T]))] - ["The class-type that is generated is of the fully-qualified name." - "This avoids a clash between the java.util.List type, and Lux's own List type." - "All enum options to be imported must be specified." - (import java/lang/Character$UnicodeScript - "[1]::[0]" - ("enum" ARABIC CYRILLIC LATIN))] - ["It should also be noted, the only types that may show up in method arguments or return values may be Java classes, arrays, primitives, void or type-parameters." - "Lux types, such as Maybe cannot be named (otherwise, they'd be confused for Java classes)." - (import (lux/concurrency/async/JvmAsync A) - "[1]::[0]" - (resolve [A] boolean) - (poll [] A) - (wasResolved [] boolean) - (waitOn [lux/Function] void) - ("static" [A] make [A] (lux/concurrency/async/JvmAsync A)))] - ["Also, the names of the imported members will look like Class::member" - (java/lang/Object::new []) - (java/lang/Object::equals [other_object] my_object) - (java/util/List::size [] my_list) - java/lang/Character$UnicodeScript::LATIN]) - -(documentation: /.array - "Create an array of the given type, with the given size." - [(array java/lang/Object 10)]) - -(documentation: /.length - "Gives the length of an array." - [(length my_array)]) - -(documentation: /.read! - "Loads an element from an array." - [(read! 10 my_array)]) - -(documentation: /.write! - "Stores an element into an array." - [(write! 10 my_object my_array)]) - -(documentation: /.class_for - "Loads the class as a java.lang.Class object." - [(is (Primitive "java.lang.Class" ["java.lang.Object"]) - (class_for java/lang/String))]) - -(documentation: /.type - "" - [(is .Type - (type java/lang/String))]) - -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [..byte_to_long - ..short_to_long - ..double_to_int - ..double_to_long - ..double_to_float - ..float_to_int - ..float_to_long - ..float_to_double - ..int_to_byte - ..int_to_short - ..int_to_long - ..int_to_float - ..int_to_double - ..int_to_char - ..long_to_byte - ..long_to_short - ..long_to_int - ..long_to_float - ..long_to_double - ..char_to_byte - ..char_to_short - ..char_to_int - ..char_to_long - ..class - ..interface - ..object - ..null - ..null? - ..??? - ..!!! - ..check - ..synchronized - ..do_to - ..import - ..array - ..length - ..read! - ..write! - ..class_for - ..type - ($.default /.Privacy) - ($.default /.State) - ($.default /.Inheritance)] - [])) +(`` (.def .public documentation + (.List $.Module) + ($.module /._ + "" + [($.default /.Privacy) + ($.default /.State) + ($.default /.Inheritance) + + (~~ (with_template [<name> <from> <to>] + [($.documentation <name> + "Type converter.")] + + [/.byte_to_long "java.lang.Byte" "java.lang.Long"] + + [/.short_to_long "java.lang.Short" "java.lang.Long"] + + [/.double_to_int "java.lang.Double" "java.lang.Integer"] + [/.double_to_long "java.lang.Double" "java.lang.Long"] + [/.double_to_float "java.lang.Double" "java.lang.Float"] + + [/.float_to_int "java.lang.Float" "java.lang.Integer"] + [/.float_to_long "java.lang.Float" "java.lang.Long"] + [/.float_to_double "java.lang.Float" "java.lang.Double"] + + [/.int_to_byte "java.lang.Integer" "java.lang.Byte"] + [/.int_to_short "java.lang.Integer" "java.lang.Short"] + [/.int_to_long "java.lang.Integer" "java.lang.Long"] + [/.int_to_float "java.lang.Integer" "java.lang.Float"] + [/.int_to_double "java.lang.Integer" "java.lang.Double"] + [/.int_to_char "java.lang.Integer" "java.lang.Character"] + + [/.long_to_byte "java.lang.Long" "java.lang.Byte"] + [/.long_to_short "java.lang.Long" "java.lang.Short"] + [/.long_to_int "java.lang.Long" "java.lang.Integer"] + [/.long_to_float "java.lang.Long" "java.lang.Float"] + [/.long_to_double "java.lang.Long" "java.lang.Double"] + + [/.char_to_byte "java.lang.Character" "java.lang.Byte"] + [/.char_to_short "java.lang.Character" "java.lang.Short"] + [/.char_to_int "java.lang.Character" "java.lang.Integer"] + [/.char_to_long "java.lang.Character" "java.lang.Long"] + )) + + ($.documentation /.class + "Allows defining JVM classes in Lux code." + [(class "final" (TestClass A) [Runnable] + ... Fields + ("private" foo boolean) + ("private" bar A) + ("private" baz java/lang/Object) + ... Methods + ("public" [] (new [value A]) [] + (exec + (:= ::foo #1) + (:= ::bar value) + (:= ::baz "") + [])) + ("public" (virtual) java/lang/Object + "") + ("public" "static" (static) java/lang/Object + "") + (Runnable [] (run) void + [])) + "The tuple corresponds to parent interfaces." + "An optional super-class can be specified before the tuple. If not specified, java.lang.Object will be assumed." + "Fields and methods defined in the class can be used with special syntax." + "For example:" + "::resolved, for accessing the 'resolved' field." + "(:= ::resolved #1) for modifying it." + "(::new! []) for calling the class's constructor." + "(::resolve! container [value]) for calling the 'resolve' method."]) + + ($.documentation /.interface + "Allows defining JVM interfaces." + [(interface TestInterface + ([] foo [boolean String] void "throws" [Exception]))]) + + ($.documentation /.object + "Allows defining anonymous classes." + ["The 1st tuple corresponds to class-level type-variables." + "The 2nd tuple corresponds to parent interfaces." + "The 3rd tuple corresponds to arguments to the super class constructor." + "An optional super-class can be specified before the 1st tuple. If not specified, java.lang.Object will be assumed." + (object [] [Runnable] + [] + (Runnable [] (run self) void + (exec (do_something some_value) + [])))]) + + ($.documentation /.null + "Null object reference." + (null)) + + ($.documentation /.null? + "Test for null object reference." + [(= (null? (null)) + true)] + [(= (null? "YOLO") + false)]) + + ($.documentation /.??? + "Takes a (potentially null) ObjectType reference and creates a (Maybe ObjectType) for it." + [(= (??? (is java/lang/String (null))) + {.#None})] + [(= (??? "YOLO") + {.#Some "YOLO"})]) + + ($.documentation /.!!! + "Takes a (Maybe ObjectType) and returns a ObjectType." + [(= "foo" + (!!! (??? "foo")))] + ["A .#None would get translated into a (null)." + (= (null) + (!!! (??? (is java/lang/Thread (null)))))]) + + ($.documentation /.check + (format "Checks whether an object is an instance of a particular class." + \n "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes.") + [(case (check java/lang/String "YOLO") + {.#Some value_as_string} + {.#None})]) + + ($.documentation /.synchronized + "Evaluates body, while holding a lock on a given object." + [(synchronized object_to_be_locked + (exec + (do something) + (do_something else) + (finish the computation)))]) + + ($.documentation /.do_to + "Call a variety of methods on an object. Then, return the object." + [(do_to object + (ClassName::method0 arg0 arg1 arg2) + (ClassName::method1 arg3 arg4 arg5))]) + + ($.documentation /.import + (format "Allows importing JVM classes, and using them as types." + \n "Their methods, fields and enum options can also be imported.") + [(import java/lang/Object + "[1]::[0]" + (new []) + (equals [java/lang/Object] boolean) + (wait [int] "io" "try" void))] + ["Special options can also be given for the return values." + "'?' means that the values will be returned inside a Maybe type. That way, null becomes .#None." + "'try' means that the computation might throw an exception, and the return value will be wrapped by the Try type." + "'io' means the computation has side effects, and will be wrapped by the IO type." + "These options must show up in the following order ['io' 'try' '?'] (although, each option can be used independently)." + (import java/lang/String + "[1]::[0]" + (new [[byte]]) + ("static" valueOf [char] java/lang/String) + ("static" valueOf "as" int_valueOf [int] java/lang/String)) + + (import (java/util/List e) + "[1]::[0]" + (size [] int) + (get [int] e)) + + (import (java/util/ArrayList a) + "[1]::[0]" + ([T] toArray [[T]] [T]))] + ["The class-type that is generated is of the fully-qualified name." + "This avoids a clash between the java.util.List type, and Lux's own List type." + "All enum options to be imported must be specified." + (import java/lang/Character$UnicodeScript + "[1]::[0]" + ("enum" ARABIC CYRILLIC LATIN))] + ["It should also be noted, the only types that may show up in method arguments or return values may be Java classes, arrays, primitives, void or type-parameters." + "Lux types, such as Maybe cannot be named (otherwise, they'd be confused for Java classes)." + (import (lux/concurrency/async/JvmAsync A) + "[1]::[0]" + (resolve [A] boolean) + (poll [] A) + (wasResolved [] boolean) + (waitOn [lux/Function] void) + ("static" [A] make [A] (lux/concurrency/async/JvmAsync A)))] + ["Also, the names of the imported members will look like Class::member" + (java/lang/Object::new []) + (java/lang/Object::equals [other_object] my_object) + (java/util/List::size [] my_list) + java/lang/Character$UnicodeScript::LATIN]) + + ($.documentation /.array + "Create an array of the given type, with the given size." + [(array java/lang/Object 10)]) + + ($.documentation /.length + "Gives the length of an array." + [(length my_array)]) + + ($.documentation /.read! + "Loads an element from an array." + [(read! 10 my_array)]) + + ($.documentation /.write! + "Stores an element into an array." + [(write! 10 my_object my_array)]) + + ($.documentation /.class_for + "Loads the class as a java.lang.Class object." + [(is (Primitive "java.lang.Class" ["java.lang.Object"]) + (class_for java/lang/String))]) + + ($.documentation /.type + "" + [(is .Type + (type java/lang/String))])] + []))) diff --git a/stdlib/source/documentation/lux/ffi.py.lux b/stdlib/source/documentation/lux/ffi.py.lux index 3feb67e74..0d5a5771f 100644 --- a/stdlib/source/documentation/lux/ffi.py.lux +++ b/stdlib/source/documentation/lux/ffi.py.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except int char) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,50 +10,48 @@ [\\library ["[0]" /]]) -(documentation: /.import - "Easily import types, methods, functions and constants." - [(import os - "[1]::[0]" - ("static" F_OK Integer) - ("static" R_OK Integer) - ("static" W_OK Integer) - ("static" X_OK Integer) - - ("static" mkdir [String] "io" "try" "?" Any) - ("static" access [String Integer] "io" "try" Boolean) - ("static" remove [String] "io" "try" "?" Any) - ("static" rmdir [String] "io" "try" "?" Any) - ("static" rename [String String] "io" "try" "?" Any) - ("static" listdir [String] "io" "try" (Array String))) - - (import os/path - "[1]::[0]" - ("static" isfile [String] "io" "try" Boolean) - ("static" isdir [String] "io" "try" Boolean) - ("static" sep String) - ("static" getsize [String] "io" "try" Integer) - ("static" getmtime [String] "io" "try" Float))]) - -(documentation: /.lambda - (format "Allows defining closures/anonymous-functions in the form that Python expects." - \n "This is useful for adapting Lux functions for usage by Python code.") - [(is ..Function - (lambda [left right] - (do_something (as Foo left) - (as Bar right))))]) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..import - ..lambda - ($.default (/.Object brand)) + [($.default (/.Object brand)) ($.default /.None) ($.default /.Dict) ($.default /.Function) ($.default /.Boolean) ($.default /.Integer) ($.default /.Float) - ($.default /.String)] + ($.default /.String) + + ($.documentation /.import + "Easily import types, methods, functions and constants." + [(import os + "[1]::[0]" + ("static" F_OK Integer) + ("static" R_OK Integer) + ("static" W_OK Integer) + ("static" X_OK Integer) + + ("static" mkdir [String] "io" "try" "?" Any) + ("static" access [String Integer] "io" "try" Boolean) + ("static" remove [String] "io" "try" "?" Any) + ("static" rmdir [String] "io" "try" "?" Any) + ("static" rename [String String] "io" "try" "?" Any) + ("static" listdir [String] "io" "try" (Array String))) + + (import os/path + "[1]::[0]" + ("static" isfile [String] "io" "try" Boolean) + ("static" isdir [String] "io" "try" Boolean) + ("static" sep String) + ("static" getsize [String] "io" "try" Integer) + ("static" getmtime [String] "io" "try" Float))]) + + ($.documentation /.lambda + (format "Allows defining closures/anonymous-functions in the form that Python expects." + \n "This is useful for adapting Lux functions for usage by Python code.") + [(is ..Function + (lambda [left right] + (do_something (as Foo left) + (as Bar right))))])] [])) diff --git a/stdlib/source/documentation/lux/ffi.rb.lux b/stdlib/source/documentation/lux/ffi.rb.lux index 86cff83d3..3ea02446e 100644 --- a/stdlib/source/documentation/lux/ffi.rb.lux +++ b/stdlib/source/documentation/lux/ffi.rb.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except int char) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,36 +10,35 @@ [\\library ["[0]" /]]) -(documentation: /.import - "Easily import types, methods, functions and constants." - [(import Stat - "[1]::[0]" - (executable? [] Bit) - (size Int)) - - (import File "as" RubyFile - "[1]::[0]" - ("static" SEPARATOR ..String) - ("static" open [Path ..String] "io" "try" RubyFile) - ("static" stat [Path] "io" "try" Stat) - ("static" delete [Path] "io" "try" Int) - ("static" file? [Path] "io" "try" Bit) - ("static" directory? [Path] "io" "try" Bit) - - (read [] "io" "try" Binary) - (write [Binary] "io" "try" Int) - (flush [] "io" "try" "?" Any) - (close [] "io" "try" "?" Any))]) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..import - ($.default (/.Object brand)) + [($.default (/.Object brand)) ($.default /.Nil) ($.default /.Function) ($.default /.Integer) ($.default /.Float) - ($.default /.String)] + ($.default /.String) + + ($.documentation /.import + "Easily import types, methods, functions and constants." + [(import Stat + "[1]::[0]" + (executable? [] Bit) + (size Int)) + + (import File "as" RubyFile + "[1]::[0]" + ("static" SEPARATOR ..String) + ("static" open [Path ..String] "io" "try" RubyFile) + ("static" stat [Path] "io" "try" Stat) + ("static" delete [Path] "io" "try" Int) + ("static" file? [Path] "io" "try" Bit) + ("static" directory? [Path] "io" "try" Bit) + + (read [] "io" "try" Binary) + (write [Binary] "io" "try" Int) + (flush [] "io" "try" "?" Any) + (close [] "io" "try" "?" Any))])] [])) diff --git a/stdlib/source/documentation/lux/program.lux b/stdlib/source/documentation/lux/program.lux index e6301fc55..fc830b881 100644 --- a/stdlib/source/documentation/lux/program.lux +++ b/stdlib/source/documentation/lux/program.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - ["$" documentation (.only documentation:)] + ["$" documentation] [control ["[0]" io]] [data @@ -12,22 +12,20 @@ [\\library ["[0]" /]]) -(documentation: /.program: - "Defines the entry-point to a program (similar to the 'main' function/method in other programming languages)." - ["Can take a list of all the input parameters to the program." - (program: all_arguments - (do io.monad - [foo (initialize program)] - (do_something_with all_arguments)))] - ["Can also parse them using CLI parsers from the library/lux/control/parser/cli module." - (program: [config configuration_parser] - (do io.monad - [data (initialize program with config)] - (do_something_with data)))]) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..program:] + [($.documentation /.program: + "Defines the entry-point to a program (similar to the 'main' function/method in other programming languages)." + ["Can take a list of all the input parameters to the program." + (program: all_arguments + (do io.monad + [foo (initialize program)] + (do_something_with all_arguments)))] + ["Can also parse them using CLI parsers from the library/lux/control/parser/cli module." + (program: [config configuration_parser] + (do io.monad + [data (initialize program with config)] + (do_something_with data)))])] [])) diff --git a/stdlib/source/documentation/lux/static.lux b/stdlib/source/documentation/lux/static.lux index aa11a339e..08b82e86c 100644 --- a/stdlib/source/documentation/lux/static.lux +++ b/stdlib/source/documentation/lux/static.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except nat int rev) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text ["%" \\format (.only format)]] @@ -10,59 +10,47 @@ [\\library ["[0]" /]]) -(with_template [<name> <type>] - [(documentation: <name> - (%.code (' (<name> - (is <type> - (value generating expression))))))] +(`` (.def .public documentation + (.List $.Module) + ($.module /._ + "" + [(~~ (with_template [<name> <type>] + [($.documentation <name> + (%.code (' (<name> + (is <type> + (value generating expression))))))] - [/.nat .Nat] - [/.int .Int] - [/.rev .Rev] - [/.frac .Frac] - [/.text .Text] - ) + [/.nat .Nat] + [/.int .Int] + [/.rev .Rev] + [/.frac .Frac] + [/.text .Text] + )) -(documentation: /.literal - "" - [(/.literal - (is (-> ??? Code) - format) - (is ??? - (value generating expression)))]) + ($.documentation /.literal + "" + [(/.literal + (is (-> ??? Code) + format) + (is ??? + (value generating expression)))]) -(with_template [<name> <type>] - [(documentation: <name> - (%.code (' (is <type> - (<name>)))))] + (~~ (with_template [<name> <type>] + [($.documentation <name> + (%.code (' (is <type> + (<name>)))))] - [/.random_nat .Nat] - [/.random_int .Int] - [/.random_rev .Rev] - [/.random_frac .Frac] - ) + [/.random_nat .Nat] + [/.random_int .Int] + [/.random_rev .Rev] + [/.random_frac .Frac] + )) -(documentation: /.random - "" - [(/.random - (is (-> ??? Code) - format) - (is (Random ???) - (random data generator)))]) - -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [..nat - ..int - ..rev - ..frac - ..text - ..literal - ..random_nat - ..random_int - ..random_rev - ..random_frac - ..random] - [])) + ($.documentation /.random + "" + [(/.random + (is (-> ??? Code) + format) + (is (Random ???) + (random data generator)))])] + []))) diff --git a/stdlib/source/documentation/lux/test.lux b/stdlib/source/documentation/lux/test.lux index b9196ae25..f15eacf9d 100644 --- a/stdlib/source/documentation/lux/test.lux +++ b/stdlib/source/documentation/lux/test.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except and for) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,116 +10,97 @@ [\\library ["[0]" /]]) -(documentation: /.Tally - "A record of successes and failures while executing tests.") - -(documentation: /.Assertion - "An asynchronous operation that yields test results.") - -(documentation: /.Test - "A test that relies on random data generation to thoroughly cover different scenarios.") - -(documentation: /.and' - "Sequencing combinator (for assertions)." - [(and' left right)]) - -(documentation: /.and - "Sequencing combinator." - [(and left right)]) - -(documentation: /.context - "Adds a contextual description to a test's documentation." - [(context description)]) - -(documentation: /.failure - "A failing test, with a given error message.") - -(documentation: /.assertion - "Check that a condition is #1, and fail with the given message otherwise." - [(assertion message condition)]) - -(documentation: /.property - "Check that a condition is #1, and fail with the given message otherwise." - [(property message condition)]) - -(documentation: /.lifted - "" - [(lifted message random)]) - -(documentation: /.Seed - "The seed value used for random testing (if that feature is used).") - -(documentation: /.seed - (format "Execute the given test with a specific seed value." - \n "This allows you to reproduce a failing test case as many times as you want while debugging.") - [(seed value test)]) - -(documentation: /.times - (format "Allows executing a test several times." - \n "By doing this, it's possible to thoroughly test code with many different scenarios." - \n "This assumes that random data generation is being used in tests instead of fixed/constant inputs.") - [(times amount test)]) - -(documentation: /.run! - (format "Executes a test, and exits the program with either a successful or a failing exit code." - \n "WARNING: This procedure is only meant to be used in (program: ...) forms.") - [(run! test)]) - -(documentation: /.coverage' - (format "Specifies a test as covering one or more definitions." - \n "Adds to the test tally information to track which definitions have been tested.") - [(coverage' [definition/0 definition/1 ,,, definition/N] - (is Bit - (some "computation")))]) - -(documentation: /.coverage - (format "Specifies a test as covering one or more definitions." - \n "Adds to the test tally information to track which definitions have been tested.") - [(coverage [definition/0 definition/1 ,,, definition/N] - (is Bit - (some "computation")))]) - -(documentation: /.for - (format "Specifies a context for tests as covering one or more definitions." - \n "Adds to the test tally information to track which definitions have been tested.") - [(for [definition/0 definition/1 ,,, definition/N] - (is Test - some_test))]) - -(documentation: /.covering - (format "Specifies the module being covered by a test." - \n "Adds tracking information to the tally to know which exported definitions in the module need to be covered.") - [(covering .._ - (is Test - some_test))]) - -(documentation: /.in_parallel - "Executes multiple tests in parallel (if the host platform supports it) to take advantage of multiple cores." - [(in_parallel tests)]) - (.def .public documentation (.List $.Module) ($.module /._ "Tools for unit & property-based/generative testing." - [..Tally - ..Assertion - ..Test - ..and' - ..and - ..context - ..failure - ..assertion - ..property - ..lifted - ..Seed - ..seed - ..times - ..run! - ..coverage' - ..coverage - ..for - ..covering - ..in_parallel - ($.default /.must_try_test_at_least_once) - ($.default /.error_during_execution)] + [($.default /.must_try_test_at_least_once) + ($.default /.error_during_execution) + + ($.documentation /.Tally + "A record of successes and failures while executing tests.") + + ($.documentation /.Assertion + "An asynchronous operation that yields test results.") + + ($.documentation /.Test + "A test that relies on random data generation to thoroughly cover different scenarios.") + + ($.documentation /.and' + "Sequencing combinator (for assertions)." + [(and' left right)]) + + ($.documentation /.and + "Sequencing combinator." + [(and left right)]) + + ($.documentation /.context + "Adds a contextual description to a test's documentation." + [(context description)]) + + ($.documentation /.failure + "A failing test, with a given error message.") + + ($.documentation /.assertion + "Check that a condition is #1, and fail with the given message otherwise." + [(assertion message condition)]) + + ($.documentation /.property + "Check that a condition is #1, and fail with the given message otherwise." + [(property message condition)]) + + ($.documentation /.lifted + "" + [(lifted message random)]) + + ($.documentation /.Seed + "The seed value used for random testing (if that feature is used).") + + ($.documentation /.seed + (format "Execute the given test with a specific seed value." + \n "This allows you to reproduce a failing test case as many times as you want while debugging.") + [(seed value test)]) + + ($.documentation /.times + (format "Allows executing a test several times." + \n "By doing this, it's possible to thoroughly test code with many different scenarios." + \n "This assumes that random data generation is being used in tests instead of fixed/constant inputs.") + [(times amount test)]) + + ($.documentation /.run! + (format "Executes a test, and exits the program with either a successful or a failing exit code." + \n "WARNING: This procedure is only meant to be used in (program: ...) forms.") + [(run! test)]) + + ($.documentation /.coverage' + (format "Specifies a test as covering one or more definitions." + \n "Adds to the test tally information to track which definitions have been tested.") + [(coverage' [definition/0 definition/1 ,,, definition/N] + (is Bit + (some "computation")))]) + + ($.documentation /.coverage + (format "Specifies a test as covering one or more definitions." + \n "Adds to the test tally information to track which definitions have been tested.") + [(coverage [definition/0 definition/1 ,,, definition/N] + (is Bit + (some "computation")))]) + + ($.documentation /.for + (format "Specifies a context for tests as covering one or more definitions." + \n "Adds to the test tally information to track which definitions have been tested.") + [(for [definition/0 definition/1 ,,, definition/N] + (is Test + some_test))]) + + ($.documentation /.covering + (format "Specifies the module being covered by a test." + \n "Adds tracking information to the tally to know which exported definitions in the module need to be covered.") + [(covering .._ + (is Test + some_test))]) + + ($.documentation /.in_parallel + "Executes multiple tests in parallel (if the host platform supports it) to take advantage of multiple cores." + [(in_parallel tests)])] [])) diff --git a/stdlib/source/documentation/lux/type/unit.lux b/stdlib/source/documentation/lux/type/unit.lux index 204154496..c7f4948ab 100644 --- a/stdlib/source/documentation/lux/type/unit.lux +++ b/stdlib/source/documentation/lux/type/unit.lux @@ -37,7 +37,7 @@ ($.default /.*) ($.default /./) - ($.documentation (/.Qty unit) + ($.documentation (/.Measure unit) "A quantity with an associated unit of measurement.") ($.documentation (/.Unit unit) @@ -47,7 +47,7 @@ "A scale of magnitude.") ($.documentation /.Pure - "A pure, unit-less quantity.") + "A pure, unit-less measure.") ($.documentation /.unit (format "Define a unit of measurement." @@ -60,7 +60,7 @@ ($.documentation /.re_scaled "" - [(re_scaled from to quantity)]) + [(re_scaled from to measure)]) (~~ (with_template [<type> <scale>] [(`` ($.documentation <scale> diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 891065652..9b479ce35 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -813,7 +813,7 @@ {#End}}}))) #0) -("lux def" def-3 +("lux def" def' ("lux macro" (function'' [tokens] ({{#Item [export_policy @@ -830,7 +830,7 @@ {#End}]}) _ - (failure "Wrong syntax for def-3")} + (failure "Wrong syntax for def'")} tokens))) #0) @@ -846,580 +846,553 @@ tokens))) #1) -(def-3 .public comment - Macro - (macro (_ tokens) - (meta#in {#End}))) - -(def-3 .private $' - Macro - (macro (_ tokens) - ({{#Item x {#End}} - (meta#in tokens) +(def' .public comment + Macro + (macro (_ tokens) + (meta#in {#End}))) - {#Item x {#Item y xs}} - (meta#in {#Item (form$ {#Item (symbol$ [..prelude "$'"]) - {#Item (variant$ {#Item (symbol$ [..prelude "#Apply"]) - {#Item y {#Item x {#End}}}}) - xs}}) - {#End}}) +(def' .private $' + Macro + (macro (_ tokens) + ({{#Item x {#End}} + (meta#in tokens) - _ - (failure "Wrong syntax for $'")} - tokens))) - -(def-3 .private (list#mix f init xs) - ... (All (_ a b) (-> (-> b a a) a (List b) a)) - {#UnivQ {#End} {#UnivQ {#End} {#Function {#Function {#Parameter 1} - {#Function {#Parameter 3} - {#Parameter 3}}} - {#Function {#Parameter 3} - {#Function ($' List {#Parameter 1}) - {#Parameter 3}}}}}} - ({{#End} - init - - {#Item x xs'} - (list#mix f (f x init) xs')} - xs)) - -(def-3 .private (list#reversed list) - {#UnivQ {#End} - {#Function ($' List {#Parameter 1}) ($' List {#Parameter 1})}} - (list#mix ("lux type check" {#UnivQ {#End} - {#Function {#Parameter 1} {#Function ($' List {#Parameter 1}) ($' List {#Parameter 1})}}} - (function'' [head tail] {#Item head tail})) - {#End} - list)) - -(def-3 .private (list#each f xs) - {#UnivQ {#End} - {#UnivQ {#End} - {#Function {#Function {#Parameter 3} {#Parameter 1}} - {#Function ($' List {#Parameter 3}) - ($' List {#Parameter 1})}}}} - (list#mix (function'' [head tail] {#Item (f head) tail}) - {#End} - (list#reversed xs))) - -(def-3 .private Replacement_Environment - Type - ($' List {#Product Text Code})) - -(def-3 .private (replacement_environment xs ys) - {#Function ($' List Text) {#Function ($' List Code) Replacement_Environment}} - ({[{#Item x xs'} {#Item y ys'}] - {#Item [x y] (replacement_environment xs' ys')} + {#Item x {#Item y xs}} + (meta#in {#Item (form$ {#Item (symbol$ [..prelude "$'"]) + {#Item (variant$ {#Item (symbol$ [..prelude "#Apply"]) + {#Item y {#Item x {#End}}}}) + xs}}) + {#End}}) - _ - {#End}} - [xs ys])) - -(def-3 .private (text#= reference sample) - {#Function Text {#Function Text Bit}} - ("lux text =" reference sample)) - -(def-3 .private (replacement for environment) - {#Function Text {#Function Replacement_Environment ($' Maybe Code)}} - ({{#End} - {#None} - - {#Item [k v] environment'} - ({[#1] {#Some v} - [#0] (replacement for environment')} - (text#= k for))} - environment)) - -(def-3 .private (with_replacements reps syntax) - {#Function Replacement_Environment {#Function Code Code}} - ({[_ {#Symbol "" name}] - ({{#Some replacement} - replacement - - {#None} - syntax} - (..replacement name reps)) - - [meta {#Form parts}] - [meta {#Form (list#each (with_replacements reps) parts)}] - - [meta {#Variant members}] - [meta {#Variant (list#each (with_replacements reps) members)}] - - [meta {#Tuple members}] - [meta {#Tuple (list#each (with_replacements reps) members)}] - - _ - syntax} - syntax)) - -(def-3 .private (n/* param subject) - {#Function Nat {#Function Nat Nat}} - ("lux type as" Nat - ("lux i64 *" - ("lux type as" Int param) - ("lux type as" Int subject)))) - -(def-3 .private (list#size list) - {#UnivQ {#End} - {#Function ($' List {#Parameter 1}) Nat}} - (list#mix (function'' [_ acc] ("lux i64 +" 1 acc)) 0 list)) - -(def-3 .private (let$ binding value body) - {#Function Code {#Function Code {#Function Code Code}}} - (form$ {#Item (variant$ {#Item binding {#Item body {#End}}}) - {#Item value {#End}}})) - -(def-3 .private |#End| - Code - (variant$ {#Item (symbol$ [..prelude "#End"]) {#End}})) - -(def-3 .private (|#Item| head tail) - {#Function Code {#Function Code Code}} - (variant$ {#Item (symbol$ [..prelude "#Item"]) - {#Item head - {#Item tail - {#End}}}})) - -(def-3 .private (UnivQ$ body) - {#Function Code Code} - (variant$ {#Item (symbol$ [..prelude "#UnivQ"]) {#Item ..|#End| {#Item body {#End}}}})) - -(def-3 .private (ExQ$ body) - {#Function Code Code} - (variant$ {#Item (symbol$ [..prelude "#ExQ"]) {#Item ..|#End| {#Item body {#End}}}})) - -(def-3 .private quantification_level - Text - ("lux text concat" double_quote - ("lux text concat" "quantification_level" - double_quote))) - -(def-3 .private quantified - {#Function Code Code} - (let$ (local$ ..quantification_level) (nat$ 0))) - -(def-3 .private (quantified_type_parameter idx) - {#Function Nat Code} - (variant$ {#Item (symbol$ [..prelude "#Parameter"]) - {#Item (form$ {#Item (text$ "lux i64 +") - {#Item (local$ ..quantification_level) - {#Item (nat$ idx) - {#End}}}}) - {#End}}})) - -(def-3 .private (next_level depth) - {#Function Nat Nat} - ("lux i64 +" 2 depth)) - -(def-3 .private (self_id? id) - {#Function Nat Bit} - ("lux i64 =" id ("lux type as" Nat - ("lux i64 *" +2 - ("lux i64 /" +2 - ("lux type as" Int - id)))))) - -(def-3 .public (__adjusted_quantified_type__ permission depth type) - {#Function Nat {#Function Nat {#Function Type Type}}} - ({0 - ({... Jackpot! - {#Parameter id} - ({id' - ({[#0] {#Parameter id'} - [#1] {#Parameter ("lux i64 -" 2 id')}} - (self_id? id))} - ("lux i64 -" ("lux i64 -" depth id) 0)) - - ... Recur - {#Primitive name parameters} - {#Primitive name (list#each (__adjusted_quantified_type__ permission depth) - parameters)} - - {#Sum left right} - {#Sum (__adjusted_quantified_type__ permission depth left) - (__adjusted_quantified_type__ permission depth right)} - - {#Product left right} - {#Product (__adjusted_quantified_type__ permission depth left) - (__adjusted_quantified_type__ permission depth right)} - - {#Function input output} - {#Function (__adjusted_quantified_type__ permission depth input) - (__adjusted_quantified_type__ permission depth output)} - - {#UnivQ environment body} - {#UnivQ environment - (__adjusted_quantified_type__ permission (next_level depth) body)} - - {#ExQ environment body} - {#ExQ environment - (__adjusted_quantified_type__ permission (next_level depth) body)} - - {#Apply parameter function} - {#Apply (__adjusted_quantified_type__ permission depth parameter) - (__adjusted_quantified_type__ permission depth function)} - - ... Leave these alone. - {#Named name anonymous} type - {#Var id} type - {#Ex id} type} - type) + _ + (failure "Wrong syntax for $'")} + tokens))) + +(def' .private (list#mix f init xs) + ... (All (_ a b) (-> (-> b a a) a (List b) a)) + {#UnivQ {#End} {#UnivQ {#End} {#Function {#Function {#Parameter 1} + {#Function {#Parameter 3} + {#Parameter 3}}} + {#Function {#Parameter 3} + {#Function ($' List {#Parameter 1}) + {#Parameter 3}}}}}} + ({{#End} + init + + {#Item x xs'} + (list#mix f (f x init) xs')} + xs)) + +(def' .private (list#reversed list) + {#UnivQ {#End} + {#Function ($' List {#Parameter 1}) ($' List {#Parameter 1})}} + (list#mix ("lux type check" {#UnivQ {#End} + {#Function {#Parameter 1} {#Function ($' List {#Parameter 1}) ($' List {#Parameter 1})}}} + (function'' [head tail] {#Item head tail})) + {#End} + list)) + +(def' .private (list#each f xs) + {#UnivQ {#End} + {#UnivQ {#End} + {#Function {#Function {#Parameter 3} {#Parameter 1}} + {#Function ($' List {#Parameter 3}) + ($' List {#Parameter 1})}}}} + (list#mix (function'' [head tail] {#Item (f head) tail}) + {#End} + (list#reversed xs))) - _ - type} - permission)) - -(def-3 .private (with_correct_quantification body) - {#Function Code Code} - (form$ {#Item (symbol$ [prelude "__adjusted_quantified_type__"]) - {#Item (local$ ..quantification_level) - {#Item (nat$ 0) - {#Item body - {#End}}}}})) - -(def-3 .private (with_quantification depth body) - {#Function Nat {#Function Code Code}} - ({g!level - (let$ g!level - (form$ {#Item (text$ "lux i64 +") - {#Item g!level - {#Item (nat$ ("lux type as" Nat - ("lux i64 *" +2 - ("lux type as" Int - depth)))) - {#End}}}}) - body)} - (local$ ..quantification_level))) - -(def-3 .private (initialized_quantification? lux) - {#Function Lux Bit} - ({[..#info _ ..#source _ ..#current_module _ ..#modules _ - ..#scopes scopes ..#type_context _ ..#host _ - ..#seed _ ..#expected _ ..#location _ ..#extensions _ - ..#scope_type_vars _ ..#eval _] - (list#mix (function'' [scope verdict] - ({[#1] #1 - _ ({[..#name _ ..#inner _ ..#captured _ - ..#locals [..#counter _ - ..#mappings locals]] - (list#mix (function'' [local verdict] - ({[local _] - ({[#1] #1 - _ ("lux text =" ..quantification_level local)} - verdict)} - local)) - #0 - locals)} - scope)} - verdict)) - #0 - scopes)} - lux)) - -(def-3 .public All - Macro - (macro (_ tokens lux) - ({{#Item [_ {#Form {#Item self_name args}}] - {#Item body {#End}}} - {#Right [lux - {#Item ({raw - ({[#1] raw - [#0] (..quantified raw)} - (initialized_quantification? lux))} - ({{#End} - body - - {#Item head tail} - (with_correct_quantification - (let$ self_name (quantified_type_parameter 0) - ({[_ raw] - raw} - (list#mix (function'' [parameter offset,body'] - ({[offset body'] - [("lux i64 +" 2 offset) - (let$ parameter (quantified_type_parameter ("lux i64 +" offset 1)) - (UnivQ$ body'))]} - offset,body')) - [0 (with_quantification (list#size args) - body)] - args))))} - args)) - {#End}}]} - - _ - {#Left "Wrong syntax for All"}} - tokens))) - -(def-3 .public Ex - Macro - (macro (_ tokens lux) - ({{#Item [_ {#Form {#Item self_name args}}] - {#Item body {#End}}} - {#Right [lux - {#Item ({raw - ({[#1] raw - [#0] (..quantified raw)} - (initialized_quantification? lux))} - ({{#End} - body - - {#Item head tail} - (with_correct_quantification - (let$ self_name (quantified_type_parameter 0) - ({[_ raw] - raw} - (list#mix (function'' [parameter offset,body'] - ({[offset body'] - [("lux i64 +" 2 offset) - (let$ parameter (quantified_type_parameter ("lux i64 +" offset 1)) - (ExQ$ body'))]} - offset,body')) - [0 (with_quantification (list#size args) - body)] - args))))} - args)) - {#End}}]} - - _ - {#Left "Wrong syntax for Ex"}} - tokens))) +(def' .private Replacement_Environment + Type + ($' List {#Product Text Code})) -(def-3 .public -> - Macro - (macro (_ tokens) - ({{#Item output inputs} - (meta#in {#Item (list#mix ("lux type check" {#Function Code {#Function Code Code}} - (function'' [i o] (variant$ {#Item (symbol$ [..prelude "#Function"]) {#Item i {#Item o {#End}}}}))) - output - inputs) - {#End}}) - - _ - (failure "Wrong syntax for ->")} - (list#reversed tokens)))) +(def' .private (replacement_environment xs ys) + {#Function ($' List Text) {#Function ($' List Code) Replacement_Environment}} + ({[{#Item x xs'} {#Item y ys'}] + {#Item [x y] (replacement_environment xs' ys')} -(def-3 .public list - Macro - (macro (_ xs) - (meta#in {#Item (list#mix |#Item| |#End| (list#reversed xs)) - {#End}}))) + _ + {#End}} + [xs ys])) -(def-3 .private partial_list - Macro - (macro (_ xs) - ({{#Item last init} - (meta#in (list (list#mix |#Item| last init))) +(def' .private (text#= reference sample) + {#Function Text {#Function Text Bit}} + ("lux text =" reference sample)) - _ - (failure "Wrong syntax for partial_list")} - (list#reversed xs)))) +(def' .private (replacement for environment) + {#Function Text {#Function Replacement_Environment ($' Maybe Code)}} + ({{#End} + {#None} -(def-3 .public Union - Macro - (macro (_ tokens) - ({{#End} - (meta#in (list (symbol$ [..prelude "Nothing"]))) + {#Item [k v] environment'} + ({[#1] {#Some v} + [#0] (replacement for environment')} + (text#= k for))} + environment)) - {#Item last prevs} - (meta#in (list (list#mix (function'' [left right] (variant$ (list (symbol$ [..prelude "#Sum"]) left right))) - last - prevs)))} - (list#reversed tokens)))) +(def' .private (with_replacements reps syntax) + {#Function Replacement_Environment {#Function Code Code}} + ({[_ {#Symbol "" name}] + ({{#Some replacement} + replacement -(def-3 .public Tuple - Macro - (macro (_ tokens) - ({{#End} - (meta#in (list (symbol$ [..prelude "Any"]))) + {#None} + syntax} + (..replacement name reps)) - {#Item last prevs} - (meta#in (list (list#mix (function'' [left right] (variant$ (list (symbol$ [..prelude "#Product"]) left right))) - last - prevs)))} - (list#reversed tokens)))) + [meta {#Form parts}] + [meta {#Form (list#each (with_replacements reps) parts)}] -(def-3 .private function' - Macro - (macro (_ tokens) - (let'' [name tokens'] ({{#Item [[_ {#Symbol ["" name]}] tokens']} - [name tokens'] - - _ - ["" tokens]} - tokens) - ({{#Item [[_ {#Tuple args}] {#Item [body {#End}]}]} - ({{#End} - (failure "function' requires a non-empty arguments tuple.") - - {#Item [harg targs]} - (meta#in (list (form$ (list (tuple$ (list (local$ name) - harg)) - (list#mix (function'' [arg body'] - (form$ (list (tuple$ (list (local$ "") - arg)) - body'))) - body - (list#reversed targs))))))} - args) + [meta {#Variant members}] + [meta {#Variant (list#each (with_replacements reps) members)}] - _ - (failure "Wrong syntax for function'")} - tokens')))) + [meta {#Tuple members}] + [meta {#Tuple (list#each (with_replacements reps) members)}] + + _ + syntax} + syntax)) + +(def' .private (n/* param subject) + {#Function Nat {#Function Nat Nat}} + ("lux type as" Nat + ("lux i64 *" + ("lux type as" Int param) + ("lux type as" Int subject)))) + +(def' .private (list#size list) + {#UnivQ {#End} + {#Function ($' List {#Parameter 1}) Nat}} + (list#mix (function'' [_ acc] ("lux i64 +" 1 acc)) 0 list)) + +(def' .private (let$ binding value body) + {#Function Code {#Function Code {#Function Code Code}}} + (form$ {#Item (variant$ {#Item binding {#Item body {#End}}}) + {#Item value {#End}}})) + +(def' .private |#End| + Code + (variant$ {#Item (symbol$ [..prelude "#End"]) {#End}})) + +(def' .private (|#Item| head tail) + {#Function Code {#Function Code Code}} + (variant$ {#Item (symbol$ [..prelude "#Item"]) + {#Item head + {#Item tail + {#End}}}})) + +(def' .private (UnivQ$ body) + {#Function Code Code} + (variant$ {#Item (symbol$ [..prelude "#UnivQ"]) {#Item ..|#End| {#Item body {#End}}}})) + +(def' .private (ExQ$ body) + {#Function Code Code} + (variant$ {#Item (symbol$ [..prelude "#ExQ"]) {#Item ..|#End| {#Item body {#End}}}})) + +(def' .private quantification_level + Text + ("lux text concat" double_quote + ("lux text concat" "quantification_level" + double_quote))) + +(def' .private quantified + {#Function Code Code} + (let$ (local$ ..quantification_level) (nat$ 0))) + +(def' .private (quantified_type_parameter idx) + {#Function Nat Code} + (variant$ {#Item (symbol$ [..prelude "#Parameter"]) + {#Item (form$ {#Item (text$ "lux i64 +") + {#Item (local$ ..quantification_level) + {#Item (nat$ idx) + {#End}}}}) + {#End}}})) + +(def' .private (next_level depth) + {#Function Nat Nat} + ("lux i64 +" 2 depth)) + +(def' .private (self_id? id) + {#Function Nat Bit} + ("lux i64 =" id ("lux type as" Nat + ("lux i64 *" +2 + ("lux i64 /" +2 + ("lux type as" Int + id)))))) + +(def' .public (__adjusted_quantified_type__ permission depth type) + {#Function Nat {#Function Nat {#Function Type Type}}} + ({0 + ({... Jackpot! + {#Parameter id} + ({id' + ({[#0] {#Parameter id'} + [#1] {#Parameter ("lux i64 -" 2 id')}} + (self_id? id))} + ("lux i64 -" ("lux i64 -" depth id) 0)) + + ... Recur + {#Primitive name parameters} + {#Primitive name (list#each (__adjusted_quantified_type__ permission depth) + parameters)} + + {#Sum left right} + {#Sum (__adjusted_quantified_type__ permission depth left) + (__adjusted_quantified_type__ permission depth right)} + + {#Product left right} + {#Product (__adjusted_quantified_type__ permission depth left) + (__adjusted_quantified_type__ permission depth right)} + + {#Function input output} + {#Function (__adjusted_quantified_type__ permission depth input) + (__adjusted_quantified_type__ permission depth output)} + + {#UnivQ environment body} + {#UnivQ environment + (__adjusted_quantified_type__ permission (next_level depth) body)} + + {#ExQ environment body} + {#ExQ environment + (__adjusted_quantified_type__ permission (next_level depth) body)} + + {#Apply parameter function} + {#Apply (__adjusted_quantified_type__ permission depth parameter) + (__adjusted_quantified_type__ permission depth function)} -(def-3 .private def-2 - Macro - (macro (_ tokens) - ({{#Item [export_policy - {#Item [[_ {#Form {#Item [name args]}}] - {#Item [type {#Item [body {#End}]}]}]}]} - (meta#in (list (form$ (list (text$ "lux def") - name - (form$ (list (text$ "lux type check") - type - (form$ (list (symbol$ [..prelude "function'"]) - name - (tuple$ args) - body)))) - export_policy)))) - - {#Item [export_policy {#Item [name {#Item [type {#Item [body {#End}]}]}]}]} - (meta#in (list (form$ (list (text$ "lux def") - name - (form$ (list (text$ "lux type check") - type - body)) - export_policy)))) + ... Leave these alone. + {#Named name anonymous} type + {#Var id} type + {#Ex id} type} + type) - _ - (failure "Wrong syntax for def-2")} - tokens))) - -(def-2 .public Or - Macro - ..Union) - -(def-2 .public And - Macro - ..Tuple) - -(def-2 .private (pairs xs) - (All (_ a) (-> ($' List a) ($' Maybe ($' List (Tuple a a))))) - ({{#Item x {#Item y xs'}} - ({{#Some tail} - {#Some {#Item [x y] tail}} - - {#None} - {#None}} - (pairs xs')) + _ + type} + permission)) + +(def' .private (with_correct_quantification body) + {#Function Code Code} + (form$ {#Item (symbol$ [prelude "__adjusted_quantified_type__"]) + {#Item (local$ ..quantification_level) + {#Item (nat$ 0) + {#Item body + {#End}}}}})) + +(def' .private (with_quantification depth body) + {#Function Nat {#Function Code Code}} + ({g!level + (let$ g!level + (form$ {#Item (text$ "lux i64 +") + {#Item g!level + {#Item (nat$ ("lux type as" Nat + ("lux i64 *" +2 + ("lux type as" Int + depth)))) + {#End}}}}) + body)} + (local$ ..quantification_level))) + +(def' .private (initialized_quantification? lux) + {#Function Lux Bit} + ({[..#info _ ..#source _ ..#current_module _ ..#modules _ + ..#scopes scopes ..#type_context _ ..#host _ + ..#seed _ ..#expected _ ..#location _ ..#extensions _ + ..#scope_type_vars _ ..#eval _] + (list#mix (function'' [scope verdict] + ({[#1] #1 + _ ({[..#name _ ..#inner _ ..#captured _ + ..#locals [..#counter _ + ..#mappings locals]] + (list#mix (function'' [local verdict] + ({[local _] + ({[#1] #1 + _ ("lux text =" ..quantification_level local)} + verdict)} + local)) + #0 + locals)} + scope)} + verdict)) + #0 + scopes)} + lux)) + +(def' .public All + Macro + (macro (_ tokens lux) + ({{#Item [_ {#Form {#Item self_name args}}] + {#Item body {#End}}} + {#Right [lux + {#Item ({raw + ({[#1] raw + [#0] (..quantified raw)} + (initialized_quantification? lux))} + ({{#End} + body + + {#Item head tail} + (with_correct_quantification + (let$ self_name (quantified_type_parameter 0) + ({[_ raw] + raw} + (list#mix (function'' [parameter offset,body'] + ({[offset body'] + [("lux i64 +" 2 offset) + (let$ parameter (quantified_type_parameter ("lux i64 +" offset 1)) + (UnivQ$ body'))]} + offset,body')) + [0 (with_quantification (list#size args) + body)] + args))))} + args)) + {#End}}]} + + _ + {#Left "Wrong syntax for All"}} + tokens))) + +(def' .public Ex + Macro + (macro (_ tokens lux) + ({{#Item [_ {#Form {#Item self_name args}}] + {#Item body {#End}}} + {#Right [lux + {#Item ({raw + ({[#1] raw + [#0] (..quantified raw)} + (initialized_quantification? lux))} + ({{#End} + body + + {#Item head tail} + (with_correct_quantification + (let$ self_name (quantified_type_parameter 0) + ({[_ raw] + raw} + (list#mix (function'' [parameter offset,body'] + ({[offset body'] + [("lux i64 +" 2 offset) + (let$ parameter (quantified_type_parameter ("lux i64 +" offset 1)) + (ExQ$ body'))]} + offset,body')) + [0 (with_quantification (list#size args) + body)] + args))))} + args)) + {#End}}]} + + _ + {#Left "Wrong syntax for Ex"}} + tokens))) + +(def' .public -> + Macro + (macro (_ tokens) + ({{#Item output inputs} + (meta#in {#Item (list#mix ("lux type check" {#Function Code {#Function Code Code}} + (function'' [i o] (variant$ {#Item (symbol$ [..prelude "#Function"]) {#Item i {#Item o {#End}}}}))) + output + inputs) + {#End}}) + + _ + (failure "Wrong syntax for ->")} + (list#reversed tokens)))) - {#End} - {#Some {#End}} +(def' .public list + Macro + (macro (_ xs) + (meta#in {#Item (list#mix |#Item| |#End| (list#reversed xs)) + {#End}}))) - _ - {#None}} - xs)) +(def' .private partial_list + Macro + (macro (_ xs) + ({{#Item last init} + (meta#in (list (list#mix |#Item| last init))) -(def-3 .private let' - Macro - (macro (_ tokens) - ({{#Item [_ {#Tuple bindings}] {#Item body {#End}}} - ({{#Some bindings} - (meta#in (list (list#mix ("lux type check" (-> (Tuple Code Code) Code - Code) - (function' [binding body] - ({[label value] - (form$ (list (variant$ (list label body)) value))} - binding))) - body - (list#reversed bindings)))) - - {#None} - (failure "Wrong syntax for let'")} - (pairs bindings)) + _ + (failure "Wrong syntax for partial_list")} + (list#reversed xs)))) + +(def' .public Union + Macro + (macro (_ tokens) + ({{#End} + (meta#in (list (symbol$ [..prelude "Nothing"]))) + + {#Item last prevs} + (meta#in (list (list#mix (function'' [left right] (variant$ (list (symbol$ [..prelude "#Sum"]) left right))) + last + prevs)))} + (list#reversed tokens)))) + +(def' .public Tuple + Macro + (macro (_ tokens) + ({{#End} + (meta#in (list (symbol$ [..prelude "Any"]))) + + {#Item last prevs} + (meta#in (list (list#mix (function'' [left right] (variant$ (list (symbol$ [..prelude "#Product"]) left right))) + last + prevs)))} + (list#reversed tokens)))) + +(def' .private function' + Macro + (macro (_ tokens) + (let'' [name tokens'] ({{#Item [[_ {#Symbol ["" name]}] tokens']} + [name tokens'] - _ - (failure "Wrong syntax for let'")} - tokens))) + _ + ["" tokens]} + tokens) + ({{#Item [[_ {#Tuple args}] {#Item [body {#End}]}]} + ({{#End} + (failure "function' requires a non-empty arguments tuple.") + + {#Item [harg targs]} + (meta#in (list (form$ (list (tuple$ (list (local$ name) + harg)) + (list#mix (function'' [arg body'] + (form$ (list (tuple$ (list (local$ "") + arg)) + body'))) + body + (list#reversed targs))))))} + args) + + _ + (failure "Wrong syntax for function'")} + tokens')))) + +(def' .public Or + Macro + ..Union) + +(def' .public And + Macro + ..Tuple) + +(def' .private (pairs xs) + (All (_ a) (-> ($' List a) ($' Maybe ($' List (Tuple a a))))) + ({{#Item x {#Item y xs'}} + ({{#Some tail} + {#Some {#Item [x y] tail}} + + {#None} + {#None}} + (pairs xs')) -(def-2 .private (any? p xs) - (All (_ a) - (-> (-> a Bit) ($' List a) Bit)) - ({{#End} - #0 - - {#Item x xs'} - ({[#1] #1 - [#0] (any? p xs')} - (p x))} - xs)) - -(def-2 .private (with_location content) - (-> Code Code) - (tuple$ (list (tuple$ (list (text$ "") (nat$ 0) (nat$ 0))) - content))) - -(def-2 .private (untemplated_list tokens) - (-> ($' List Code) Code) - ({{#End} - |#End| - - {#Item token tokens'} - (|#Item| token (untemplated_list tokens'))} - tokens)) - -(def-2 .private (list#composite xs ys) - (All (_ a) (-> ($' List a) ($' List a) ($' List a))) - (list#mix (function' [head tail] {#Item head tail}) - ys - (list#reversed xs))) - -(def-2 .private (right_associativity op a1 a2) - (-> Code Code Code Code) - ({[_ {#Form parts}] - (form$ (list#composite parts (list a1 a2))) + {#End} + {#Some {#End}} - _ - (form$ (list op a1 a2))} - op)) + _ + {#None}} + xs)) + +(def' .private let' + Macro + (macro (_ tokens) + ({{#Item [_ {#Tuple bindings}] {#Item body {#End}}} + ({{#Some bindings} + (meta#in (list (list#mix ("lux type check" (-> (Tuple Code Code) Code + Code) + (function' [binding body] + ({[label value] + (form$ (list (variant$ (list label body)) value))} + binding))) + body + (list#reversed bindings)))) + + {#None} + (failure "Wrong syntax for let'")} + (pairs bindings)) -(def-2 .private (function#flipped func) - (All (_ a b c) - (-> (-> a b c) (-> b a c))) - (function' [right left] - (func left right))) + _ + (failure "Wrong syntax for let'")} + tokens))) + +(def' .private (any? p xs) + (All (_ a) + (-> (-> a Bit) ($' List a) Bit)) + ({{#End} + #0 + + {#Item x xs'} + ({[#1] #1 + [#0] (any? p xs')} + (p x))} + xs)) + +(def' .private (with_location location content) + (-> Location Code Code) + (let' [[module line column] location] + (tuple$ (list (tuple$ (list (text$ module) (nat$ line) (nat$ column))) + content)))) + +(def' .private (untemplated_list tokens) + (-> ($' List Code) Code) + ({{#End} + |#End| + + {#Item token tokens'} + (|#Item| token (untemplated_list tokens'))} + tokens)) + +(def' .private (list#composite xs ys) + (All (_ a) (-> ($' List a) ($' List a) ($' List a))) + (list#mix (function' [head tail] {#Item head tail}) + ys + (list#reversed xs))) + +(def' .private (right_associativity op a1 a2) + (-> Code Code Code Code) + ({[_ {#Form parts}] + (form$ (list#composite parts (list a1 a2))) -(def-3 .public left - Macro - (macro (_ tokens) - ({{#Item op tokens'} - ({{#Item first nexts} - (meta#in (list (list#mix (function#flipped (right_associativity op)) first nexts))) + _ + (form$ (list op a1 a2))} + op)) + +(def' .private (function#flipped func) + (All (_ a b c) + (-> (-> a b c) (-> b a c))) + (function' [right left] + (func left right))) + +(def' .public left + Macro + (macro (_ tokens) + ({{#Item op tokens'} + ({{#Item first nexts} + (meta#in (list (list#mix (function#flipped (right_associativity op)) first nexts))) - _ - (failure "Wrong syntax for left")} - tokens') - - _ - (failure "Wrong syntax for left")} - tokens))) + _ + (failure "Wrong syntax for left")} + tokens') + + _ + (failure "Wrong syntax for left")} + tokens))) -(def-3 .public right - Macro - (macro (_ tokens) - ({{#Item op tokens'} - ({{#Item last prevs} - (meta#in (list (list#mix (right_associativity op) last prevs))) +(def' .public right + Macro + (macro (_ tokens) + ({{#Item op tokens'} + ({{#Item last prevs} + (meta#in (list (list#mix (right_associativity op) last prevs))) - _ - (failure "Wrong syntax for right")} - (list#reversed tokens')) - - _ - (failure "Wrong syntax for right")} - tokens))) + _ + (failure "Wrong syntax for right")} + (list#reversed tokens')) + + _ + (failure "Wrong syntax for right")} + tokens))) -(def-2 .public all Macro ..right) +(def' .public all Macro ..right) ... (type (Monad m) ... (Interface @@ -1439,1786 +1412,1795 @@ ["#in" "#then"] #0) -(def-2 .private maybe#monad - ($' Monad Maybe) - [#in - (function' [x] {#Some x}) - - #then - (function' [f ma] - ({{#None} {#None} - {#Some a} (f a)} - ma))]) - -(def-2 .private meta#monad - ($' Monad Meta) - [#in - (function' [x] - (function' [state] - {#Right state x})) +(def' .private maybe#monad + ($' Monad Maybe) + [#in + (function' [x] {#Some x}) + + #then + (function' [f ma] + ({{#None} {#None} + {#Some a} (f a)} + ma))]) + +(def' .private meta#monad + ($' Monad Meta) + [#in + (function' [x] + (function' [state] + {#Right state x})) + + #then + (function' [f ma] + (function' [state] + ({{#Left msg} + {#Left msg} + + {#Right [state' a]} + (f a state')} + (ma state))))]) + +(def' .private do + Macro + (macro (_ tokens) + ({{#Item monad {#Item [_ {#Tuple bindings}] {#Item body {#End}}}} + ({{#Some bindings} + (let' [g!in (local$ "in") + g!then (local$ " then ") + body' (list#mix ("lux type check" (-> (Tuple Code Code) Code Code) + (function' [binding body'] + (let' [[var value] binding] + ({[_ {#Symbol [module short]}] + ({"" + (form$ (list g!then + (form$ (list (tuple$ (list (local$ "") var)) body')) + value)) + + _ + (form$ (list var value body'))} + module) + + + _ + (form$ (list g!then + (form$ (list (tuple$ (list (local$ "") var)) body')) + value))} + var)))) + body + (list#reversed bindings))] + (meta#in (list (form$ (list (variant$ (list (tuple$ (list g!in g!then)) + body')) + monad))))) + + {#None} + (failure "Wrong syntax for do")} + (pairs bindings)) + + _ + (failure "Wrong syntax for do")} + tokens))) + +(def' .private (monad#each m f xs) + (All (_ m a b) + (-> ($' Monad m) + (-> a ($' m b)) + ($' List a) + ($' m ($' List b)))) + (let' [[..#in in ..#then _] m] + ({{#End} + (in {#End}) + + {#Item x xs'} + (do m + [y (f x) + ys (monad#each m f xs')] + (in {#Item y ys}))} + xs))) + +(def' .private (monad#mix m f y xs) + (All (_ m a b) + (-> ($' Monad m) + (-> a b ($' m b)) + b + ($' List a) + ($' m b))) + (let' [[..#in in ..#then _] m] + ({{#End} + (in y) + + {#Item x xs'} + (do m + [y' (f x y)] + (monad#mix m f y' xs'))} + xs))) + +(def' .public if + Macro + (macro (_ tokens) + ({{#Item test {#Item then {#Item else {#End}}}} + (meta#in (list (form$ (list (variant$ (list (bit$ #1) then + (bit$ #0) else)) + test)))) + + _ + (failure "Wrong syntax for if")} + tokens))) + +(def' .private PList + Type + (All (_ a) ($' List (Tuple Text a)))) + +(def' .private (plist#value k plist) + (All (_ a) + (-> Text ($' PList a) ($' Maybe a))) + ({{#Item [[k' v] plist']} + (if (text#= k k') + {#Some v} + (plist#value k plist')) + + {#End} + {#None}} + plist)) + +(def' .private (plist#with k v plist) + (All (_ a) + (-> Text a ($' PList a) ($' PList a))) + ({{#Item [k' v'] plist'} + (if (text#= k k') + (partial_list [k v] plist') + (partial_list [k' v'] (plist#with k v plist'))) + + {#End} + (list [k v])} + plist)) + +(def' .private (global_symbol full_name state) + (-> Symbol ($' Meta Symbol)) + (let' [[module name] full_name + [..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] state] + ({{#Some [..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _]} + ({{#Some constant} + ({{#Definition _} {#Right [state full_name]} + {#Tag _} {#Right [state full_name]} + {#Slot _} {#Right [state full_name]} + {#Type _} {#Right [state full_name]} + + {#Alias real_name} + {#Right [state real_name]}} + constant) + + {#None} + {#Left (all text#composite "Unknown definition: " (symbol#encoded full_name))}} + (plist#value name definitions)) + + {#None} + {#Left (all text#composite "Unknown module: " module " @ " (symbol#encoded full_name))}} + (plist#value module modules)))) + +(def' .private (|List<Code>| expression) + (-> Code Code) + (let' [type (variant$ (list (symbol$ [..prelude "#Apply"]) + (symbol$ [..prelude "Code"]) + (symbol$ [..prelude "List"])))] + (form$ (list (text$ "lux type check") type expression)))) + +(def' .private (untemplated_text location value) + (-> Location Text Code) + (with_location location (variant$ (list (symbol$ [..prelude "#Text"]) (text$ value))))) + +(def' .public UnQuote + Type + {#Primitive "#Macro/UnQuote" {#End}}) + +(def' .public (unquote it) + (-> Macro UnQuote) + ("lux type as" UnQuote it)) + +(def' .public (unquote_macro it) + (-> UnQuote Macro') + ("lux type as" Macro' it)) + +(def' .public Spliced_UnQuote + Type + {#Primitive "#Macro/Spliced_UnQuote" {#End}}) + +(def' .public (spliced_unquote it) + (-> Macro Spliced_UnQuote) + ("lux type as" Spliced_UnQuote it)) + +(def' .public (spliced_unquote_macro it) + (-> Spliced_UnQuote Macro') + ("lux type as" Macro' it)) + +(def' .private (list#one f xs) + (All (_ a b) + (-> (-> a ($' Maybe b)) ($' List a) ($' Maybe b))) + ({{#End} + {#None} + + {#Item x xs'} + ({{#None} + (list#one f xs') + + {#Some y} + {#Some y}} + (f x))} + xs)) + +(def' .private (in_env name state) + (-> Text Lux ($' Maybe Type)) + (let' [[..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] state] + (list#one ("lux type check" + (-> Scope ($' Maybe Type)) + (function' [env] + (let' [[..#name _ + ..#inner _ + ..#locals [..#counter _ ..#mappings locals] + ..#captured _] env] + (list#one ("lux type check" + (-> (Tuple Text (Tuple Type Any)) ($' Maybe Type)) + (function' [it] + (let' [[bname [type _]] it] + (if (text#= name bname) + {#Some type} + {#None})))) + locals)))) + scopes))) + +(def' .private (available? expected_module current_module exported?) + (-> Text ($' Maybe Text) Bit Bit) + (if exported? + #1 + ({{.#None} + #0 + + {.#Some current_module} + (text#= expected_module current_module)} + current_module))) + +(def' .private (definition_value name state) + (-> Symbol ($' Meta (Tuple Type Any))) + (let' [[expected_module expected_short] name + [..#info info + ..#source source + ..#current_module current_module + ..#modules modules + ..#scopes scopes + ..#type_context types + ..#host host + ..#seed seed + ..#expected expected + ..#location location + ..#extensions extensions + ..#scope_type_vars scope_type_vars + ..#eval _eval] state] + ({{#None} + {#Left (text#composite "Unknown definition: " (symbol#encoded name))} + + {#Some [..#definitions definitions + ..#module_hash _ + ..#module_aliases _ + ..#imports _ + ..#module_state _]} + ({{#None} + {#Left (text#composite "Unknown definition: " (symbol#encoded name))} + + {#Some definition} + ({{#Alias real_name} + (definition_value real_name state) + + {#Definition [exported? def_type def_value]} + (if (available? expected_module current_module exported?) + {#Right [state [def_type def_value]]} + {#Left (text#composite "Unavailable definition: " (symbol#encoded name))}) + + {#Type [exported? type labels]} + (if (available? expected_module current_module exported?) + {#Right [state [..Type type]]} + {#Left (text#composite "Unavailable definition: " (symbol#encoded name))}) + + {#Tag _} + {#Left (text#composite "Unknown definition: " (symbol#encoded name))} + + {#Slot _} + {#Left (text#composite "Unknown definition: " (symbol#encoded name))}} + definition)} + (plist#value expected_short definitions))} + (plist#value expected_module modules)))) + +(def' .private (global_value global lux) + (-> Symbol ($' Meta ($' Maybe (Tuple Type Any)))) + (let' [[module short] global] + ({{#Right [lux' type,value]} + {#Right [lux' {#Some type,value}]} + + {#Left error} + {#Right [lux {#None}]}} + ({"" ({{#None} + (definition_value global lux) + + {#Some _} + {#Left (text#composite "Not a global value: " (symbol#encoded global))}} + (in_env short lux)) + + _ + (definition_value global lux)} + module)))) + +(def' .private (bit#and left right) + (-> Bit Bit Bit) + (if left + right + #0)) + +(def' .private (symbol#= left right) + (-> Symbol Symbol Bit) + (let' [[moduleL shortL] left + [moduleR shortR] right] + (all bit#and + (text#= moduleL moduleR) + (text#= shortL shortR)))) + +(def' .private (every? ?) + (All (_ a) + (-> (-> a Bit) ($' List a) Bit)) + (list#mix (function' [_2 _1] (if _1 (? _2) #0)) #1)) + +(def' .private (zipped_2 xs ys) + (All (_ a b) + (-> ($' List a) ($' List b) ($' List (Tuple a b)))) + ({{#Item x xs'} + ({{#Item y ys'} + (partial_list [x y] (zipped_2 xs' ys')) + + _ + (list)} + ys) - #then - (function' [f ma] - (function' [state] - ({{#Left msg} - {#Left msg} - - {#Right [state' a]} - (f a state')} - (ma state))))]) - -(def-3 .private do - Macro - (macro (_ tokens) - ({{#Item monad {#Item [_ {#Tuple bindings}] {#Item body {#End}}}} - ({{#Some bindings} - (let' [g!in (local$ "in") - g!then (local$ " then ") - body' (list#mix ("lux type check" (-> (Tuple Code Code) Code Code) - (function' [binding body'] - (let' [[var value] binding] - ({[_ {#Symbol [module short]}] - ({"" - (form$ (list g!then - (form$ (list (tuple$ (list (local$ "") var)) body')) - value)) - - _ - (form$ (list var value body'))} - module) - - - _ - (form$ (list g!then - (form$ (list (tuple$ (list (local$ "") var)) body')) - value))} - var)))) - body - (list#reversed bindings))] - (meta#in (list (form$ (list (variant$ (list (tuple$ (list g!in g!then)) - body')) - monad))))) - - {#None} - (failure "Wrong syntax for do")} - (pairs bindings)) + _ + (list)} + xs)) + +(def' .private (type#= left right) + (-> Type Type Bit) + ({[{#Primitive nameL parametersL} {#Primitive nameR parametersR}] + (all bit#and + (text#= nameL nameR) + ("lux i64 =" (list#size parametersL) (list#size parametersR)) + (every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR))) + (zipped_2 parametersL parametersR))) + + [{#Sum leftL rightL} {#Sum leftR rightR}] + (all bit#and + (type#= leftL leftR) + (type#= rightL rightR)) + + [{#Product leftL rightL} {#Product leftR rightR}] + (all bit#and + (type#= leftL leftR) + (type#= rightL rightR)) + + [{#Function leftL rightL} {#Function leftR rightR}] + (all bit#and + (type#= leftL leftR) + (type#= rightL rightR)) + + [{#Apply leftL rightL} {#Apply leftR rightR}] + (all bit#and + (type#= leftL leftR) + (type#= rightL rightR)) + + [{#Parameter idL} {#Parameter idR}] + ("lux i64 =" idL idR) + + [{#Var idL} {#Var idR}] + ("lux i64 =" idL idR) + + [{#Ex idL} {#Ex idR}] + ("lux i64 =" idL idR) + + [{#UnivQ envL bodyL} {#UnivQ envR bodyR}] + (all bit#and + ("lux i64 =" (list#size envL) (list#size envR)) + (every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR))) + (zipped_2 envL envR)) + (type#= bodyL bodyR)) + + [{#ExQ envL bodyL} {#ExQ envR bodyR}] + (all bit#and + ("lux i64 =" (list#size envL) (list#size envR)) + (every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR))) + (zipped_2 envL envR)) + (type#= bodyL bodyR)) + + [{#Named nameL anonL} {#Named nameR anonR}] + (all bit#and + (symbol#= nameL nameR) + (type#= anonL anonR)) - _ - (failure "Wrong syntax for do")} - tokens))) - -(def-2 .private (monad#each m f xs) - (All (_ m a b) - (-> ($' Monad m) - (-> a ($' m b)) - ($' List a) - ($' m ($' List b)))) - (let' [[..#in in ..#then _] m] - ({{#End} - (in {#End}) - - {#Item x xs'} - (do m - [y (f x) - ys (monad#each m f xs')] - (in {#Item y ys}))} - xs))) - -(def-2 .private (monad#mix m f y xs) - (All (_ m a b) - (-> ($' Monad m) - (-> a b ($' m b)) - b - ($' List a) - ($' m b))) - (let' [[..#in in ..#then _] m] - ({{#End} - (in y) - - {#Item x xs'} - (do m - [y' (f x y)] - (monad#mix m f y' xs'))} - xs))) - -(def-3 .public if - Macro - (macro (_ tokens) - ({{#Item test {#Item then {#Item else {#End}}}} - (meta#in (list (form$ (list (variant$ (list (bit$ #1) then - (bit$ #0) else)) - test)))) + _ + #0} + [left right])) - _ - (failure "Wrong syntax for if")} - tokens))) +(def' .private (one_expansion it) + (-> ($' Meta ($' List Code)) ($' Meta Code)) + (do meta#monad + [it it] + ({{#Item it {#End}} + (in it) -(def-2 .private PList - Type - (All (_ a) ($' List (Tuple Text a)))) + _ + (failure "Must expand to 1 element.")} + it))) -(def-2 .private (plist#value k plist) - (All (_ a) - (-> Text ($' PList a) ($' Maybe a))) - ({{#Item [[k' v] plist']} - (if (text#= k k') - {#Some v} - (plist#value k plist')) +(def' .private (current_module_name state) + ($' Meta Text) + ({[..#info info ..#source source ..#current_module current_module ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] + ({{#Some module_name} + {#Right [state module_name]} - {#End} - {#None}} - plist)) + _ + {#Left "Cannot get the module name without a module!"}} + current_module)} + state)) -(def-2 .private (plist#with k v plist) - (All (_ a) - (-> Text a ($' PList a) ($' PList a))) - ({{#Item [k' v'] plist'} - (if (text#= k k') - (partial_list [k v] plist') - (partial_list [k' v'] (plist#with k v plist'))) - - {#End} - (list [k v])} - plist)) - -(def-2 .private (global_symbol full_name state) - (-> Symbol ($' Meta Symbol)) - (let' [[module name] full_name - [..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] state] - ({{#Some [..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _]} - ({{#Some constant} - ({{#Definition _} {#Right [state full_name]} - {#Tag _} {#Right [state full_name]} - {#Slot _} {#Right [state full_name]} - {#Type _} {#Right [state full_name]} - - {#Alias real_name} - {#Right [state real_name]}} - constant) - - {#None} - {#Left (all text#composite "Unknown definition: " (symbol#encoded full_name))}} - (plist#value name definitions)) - - {#None} - {#Left (all text#composite "Unknown module: " module " @ " (symbol#encoded full_name))}} - (plist#value module modules)))) - -(def-2 .private (|List<Code>| expression) - (-> Code Code) - (let' [type (variant$ (list (symbol$ [..prelude "#Apply"]) - (symbol$ [..prelude "Code"]) - (symbol$ [..prelude "List"])))] - (form$ (list (text$ "lux type check") type expression)))) - -(def-2 .private (untemplated_text value) - (-> Text Code) - (with_location (variant$ (list (symbol$ [..prelude "#Text"]) (text$ value))))) - -(def-3 .public UnQuote - Type - {#Primitive "#Macro/UnQuote" {#End}}) - -(def-3 .public (unquote it) - (-> Macro UnQuote) - ("lux type as" UnQuote it)) - -(def-3 .public (unquote_macro it) - (-> UnQuote Macro') - ("lux type as" Macro' it)) - -(def-3 .public Spliced_UnQuote - Type - {#Primitive "#Macro/Spliced_UnQuote" {#End}}) - -(def-3 .public (spliced_unquote it) - (-> Macro Spliced_UnQuote) - ("lux type as" Spliced_UnQuote it)) - -(def-3 .public (spliced_unquote_macro it) - (-> Spliced_UnQuote Macro') - ("lux type as" Macro' it)) - -(def-3 .private (list#one f xs) - (All (_ a b) - (-> (-> a ($' Maybe b)) ($' List a) ($' Maybe b))) - ({{#End} - {#None} - - {#Item x xs'} - ({{#None} - (list#one f xs') - - {#Some y} - {#Some y}} - (f x))} - xs)) - -(def-3 .private (in_env name state) - (-> Text Lux ($' Maybe Type)) - (let' [[..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] state] - (list#one ("lux type check" - (-> Scope ($' Maybe Type)) - (function' [env] - (let' [[..#name _ - ..#inner _ - ..#locals [..#counter _ ..#mappings locals] - ..#captured _] env] - (list#one ("lux type check" - (-> (Tuple Text (Tuple Type Any)) ($' Maybe Type)) - (function' [it] - (let' [[bname [type _]] it] - (if (text#= name bname) - {#Some type} - {#None})))) - locals)))) - scopes))) - -(def-3 .private (definition_value name state) - (-> Symbol ($' Meta (Tuple Type Any))) - (let' [[v_module v_name] name - [..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] state] - ({{#None} - {#Left (text#composite "Unknown definition: " (symbol#encoded name))} - - {#Some [..#definitions definitions - ..#module_hash _ - ..#module_aliases _ - ..#imports _ - ..#module_state _]} - ({{#None} - {#Left (text#composite "Unknown definition: " (symbol#encoded name))} - - {#Some definition} - ({{#Alias real_name} - (definition_value real_name state) - - {#Definition [exported? def_type def_value]} - {#Right [state [def_type def_value]]} - - {#Type [exported? type labels]} - {#Right [state [..Type type]]} - - {#Tag _} - {#Left (text#composite "Unknown definition: " (symbol#encoded name))} - - {#Slot _} - {#Left (text#composite "Unknown definition: " (symbol#encoded name))}} - definition)} - (plist#value v_name definitions))} - (plist#value v_module modules)))) - -(def-3 .private (global_value global lux) - (-> Symbol ($' Meta ($' Maybe (Tuple Type Any)))) - (let' [[module short] global] - ({{#Right [lux' type,value]} - {#Right [lux' {#Some type,value}]} - - {#Left error} - {#Right [lux {#None}]}} - ({"" ({{#None} - (definition_value global lux) - - {#Some _} - {#Left (text#composite "Not a global value: " (symbol#encoded global))}} - (in_env short lux)) +(def' .private (normal name) + (-> Symbol ($' Meta Symbol)) + ({["" name] + (do meta#monad + [module_name ..current_module_name] + (in [module_name name])) - _ - (definition_value global lux)} - module)))) - -(def-3 .private (bit#and left right) - (-> Bit Bit Bit) - (if left - right - #0)) - -(def-3 .private (symbol#= left right) - (-> Symbol Symbol Bit) - (let' [[moduleL shortL] left - [moduleR shortR] right] - (all bit#and - (text#= moduleL moduleR) - (text#= shortL shortR)))) - -(def-3 .private (every? ?) - (All (_ a) - (-> (-> a Bit) ($' List a) Bit)) - (list#mix (function' [_2 _1] (if _1 (? _2) #0)) #1)) + _ + (meta#in name)} + name)) -(def-3 .private (zipped_2 xs ys) - (All (_ a b) - (-> ($' List a) ($' List b) ($' List (Tuple a b)))) - ({{#Item x xs'} - ({{#Item y ys'} - (partial_list [x y] (zipped_2 xs' ys')) +(def' .private (untemplated_composite tag @composite untemplated replace? subst elements) + (-> Text Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) + ($' Meta Code)) + (do meta#monad + [.let' [cons ("lux type check" + (-> Code Code ($' Meta Code)) + (function' [head tail] + (do meta#monad + [head (untemplated replace? subst head)] + (in (|#Item| head tail)))))] + output (if replace? + (monad#mix meta#monad + (function' [head tail] + ({[@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}] + (do meta#monad + [|global| (..normal global) + ?type,value (global_value |global|)] + ({{#Some [type value]} + (if (type#= Spliced_UnQuote type) + (do meta#monad + [.let' [it (spliced_unquote_macro ("lux type as" Spliced_UnQuote value))] + output (one_expansion (it {#Item tail parameters})) + .let' [[_ output] output]] + (in [@composite output])) + (cons head tail)) + + {#None} + (cons head tail)} + ?type,value)) - _ - (list)} - ys) - - _ - (list)} - xs)) - -(def-3 .private (type#= left right) - (-> Type Type Bit) - ({[{#Primitive nameL parametersL} {#Primitive nameR parametersR}] - (all bit#and - (text#= nameL nameR) - ("lux i64 =" (list#size parametersL) (list#size parametersR)) - (every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR))) - (zipped_2 parametersL parametersR))) - - [{#Sum leftL rightL} {#Sum leftR rightR}] - (all bit#and - (type#= leftL leftR) - (type#= rightL rightR)) - - [{#Product leftL rightL} {#Product leftR rightR}] - (all bit#and - (type#= leftL leftR) - (type#= rightL rightR)) - - [{#Function leftL rightL} {#Function leftR rightR}] - (all bit#and - (type#= leftL leftR) - (type#= rightL rightR)) - - [{#Apply leftL rightL} {#Apply leftR rightR}] - (all bit#and - (type#= leftL leftR) - (type#= rightL rightR)) - - [{#Parameter idL} {#Parameter idR}] - ("lux i64 =" idL idR) - - [{#Var idL} {#Var idR}] - ("lux i64 =" idL idR) - - [{#Ex idL} {#Ex idR}] - ("lux i64 =" idL idR) - - [{#UnivQ envL bodyL} {#UnivQ envR bodyR}] - (all bit#and - ("lux i64 =" (list#size envL) (list#size envR)) - (every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR))) - (zipped_2 envL envR)) - (type#= bodyL bodyR)) - - [{#ExQ envL bodyL} {#ExQ envR bodyR}] - (all bit#and - ("lux i64 =" (list#size envL) (list#size envR)) - (every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR))) - (zipped_2 envL envR)) - (type#= bodyL bodyR)) - - [{#Named nameL anonL} {#Named nameR anonR}] - (all bit#and - (symbol#= nameL nameR) - (type#= anonL anonR)) + _ + (cons head tail)} + head)) + |#End| + (list#reversed elements)) + (do meta#monad + [=elements (monad#each meta#monad (untemplated replace? subst) elements)] + (in (untemplated_list =elements)))) + .let' [[_ output'] (with_location @composite (variant$ (list (symbol$ [..prelude tag]) output)))]] + (in [@composite output']))) + +(def' .private untemplated_form + (-> Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) + ($' Meta Code)) + (untemplated_composite "#Form")) + +(def' .private untemplated_variant + (-> Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) + ($' Meta Code)) + (untemplated_composite "#Variant")) + +(def' .private untemplated_tuple + (-> Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) + ($' Meta Code)) + (untemplated_composite "#Tuple")) + +(def' .private (untemplated replace? subst token) + (-> Bit Text Code ($' Meta Code)) + ({[_ [@token {#Bit value}]] + (meta#in (with_location @token (variant$ (list (symbol$ [..prelude "#Bit"]) (bit$ value))))) + + [_ [@token {#Nat value}]] + (meta#in (with_location @token (variant$ (list (symbol$ [..prelude "#Nat"]) (nat$ value))))) + + [_ [@token {#Int value}]] + (meta#in (with_location @token (variant$ (list (symbol$ [..prelude "#Int"]) (int$ value))))) + + [_ [@token {#Rev value}]] + (meta#in (with_location @token (variant$ (list (symbol$ [..prelude "#Rev"]) (rev$ value))))) + + [_ [@token {#Frac value}]] + (meta#in (with_location @token (variant$ (list (symbol$ [..prelude "#Frac"]) (frac$ value))))) - _ - #0} - [left right])) + [_ [@token {#Text value}]] + (meta#in (untemplated_text @token value)) -(def-2 .private (one_expansion it) - (-> ($' Meta ($' List Code)) ($' Meta Code)) - (do meta#monad - [it it] - ({{#Item it {#End}} - (in it) + [#1 [@token {#Symbol [module name]}]] + (do meta#monad + [real_name ({"" + (if (text#= "" subst) + (in [module name]) + (global_symbol [subst name])) - _ - (failure "Must expand to 1 element.")} - it))) - -(def-3 .private (current_module_name state) - ($' Meta Text) - ({[..#info info ..#source source ..#current_module current_module ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] - ({{#Some module_name} - {#Right [state module_name]} + _ + (in [module name])} + module) + .let' [[module name] real_name]] + (meta#in (with_location @token (variant$ (list (symbol$ [..prelude "#Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))) - _ - {#Left "Cannot get the module name without a module!"}} - current_module)} - state)) + [#0 [@token {#Symbol [module name]}]] + (meta#in (with_location @token (variant$ (list (symbol$ [..prelude "#Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) -(def-2 .private (normal name) - (-> Symbol ($' Meta Symbol)) - ({["" name] - (do meta#monad - [module_name ..current_module_name] - (in [module_name name])) + [#1 [@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}]] + (do meta#monad + [|global| (..normal global) + ?type,value (global_value |global|)] + ({{#Some [type value]} + (if (type#= UnQuote type) + (do meta#monad + [.let' [it (unquote_macro ("lux type as" UnQuote value))] + output (one_expansion (it parameters)) + .let' [[_ output] output]] + (in [@composite output])) + (untemplated_form @composite untemplated replace? subst {#Item [@symbol {#Symbol global}] parameters})) + + {#None} + (untemplated_form @composite untemplated replace? subst {#Item [@symbol {#Symbol global}] parameters})} + ?type,value)) - _ - (meta#in name)} - name)) + [_ [@composite {#Form elements}]] + (untemplated_form @composite untemplated replace? subst elements) -(def-2 .private (untemplated_composite tag @form untemplated replace? subst elements) - (-> Text Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) - ($' Meta Code)) - (do meta#monad - [.let' [cons ("lux type check" - (-> Code Code ($' Meta Code)) - (function' [head tail] - (do meta#monad - [head (untemplated replace? subst head)] - (in (|#Item| head tail)))))] - output (if replace? - (monad#mix meta#monad - (function' [head tail] - ({[@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}] - (do meta#monad - [|global| (..normal global) - ?type,value (global_value |global|)] - ({{#Some [type value]} - (if (type#= Spliced_UnQuote type) - (do meta#monad - [.let' [it (spliced_unquote_macro ("lux type as" Spliced_UnQuote value))] - output (one_expansion (it {#Item tail parameters})) - .let' [[_ output] output]] - (in [@composite output])) - (cons head tail)) - - {#None} - (cons head tail)} - ?type,value)) - - _ - (cons head tail)} - head)) - |#End| - (list#reversed elements)) - (do meta#monad - [=elements (monad#each meta#monad (untemplated replace? subst) elements)] - (in (untemplated_list =elements)))) - .let' [[_ output'] (with_location (variant$ (list (symbol$ [..prelude tag]) output)))]] - (in [@form output']))) - -(def-2 .private untemplated_form - (-> Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) - ($' Meta Code)) - (untemplated_composite "#Form")) - -(def-2 .private untemplated_variant - (-> Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) - ($' Meta Code)) - (untemplated_composite "#Variant")) - -(def-2 .private untemplated_tuple - (-> Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) - ($' Meta Code)) - (untemplated_composite "#Tuple")) - -(def-2 .private (untemplated replace? subst token) - (-> Bit Text Code ($' Meta Code)) - ({[_ [_ {#Bit value}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Bit"]) (bit$ value))))) - - [_ [_ {#Nat value}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Nat"]) (nat$ value))))) - - [_ [_ {#Int value}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Int"]) (int$ value))))) - - [_ [_ {#Rev value}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Rev"]) (rev$ value))))) - - [_ [_ {#Frac value}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Frac"]) (frac$ value))))) - - [_ [_ {#Text value}]] - (meta#in (untemplated_text value)) - - [#1 [_ {#Symbol [module name]}]] - (do meta#monad - [real_name ({"" - (if (text#= "" subst) - (in [module name]) - (global_symbol [subst name])) - - _ - (in [module name])} - module) - .let' [[module name] real_name]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))) - - [#0 [_ {#Symbol [module name]}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) - - [#1 [@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}]] - (do meta#monad - [|global| (..normal global) - ?type,value (global_value |global|)] - ({{#Some [type value]} - (if (type#= UnQuote type) - (do meta#monad - [.let' [it (unquote_macro ("lux type as" UnQuote value))] - output (one_expansion (it parameters)) - .let' [[_ output] output]] - (in [@composite output])) - (untemplated_form @composite untemplated replace? subst {#Item [@symbol {#Symbol global}] parameters})) - - {#None} - (untemplated_form @composite untemplated replace? subst {#Item [@symbol {#Symbol global}] parameters})} - ?type,value)) - - [_ [@composite {#Form elements}]] - (untemplated_form @composite untemplated replace? subst elements) - - [_ [@composite {#Variant elements}]] - (untemplated_variant @composite untemplated replace? subst elements) - - [_ [@composite {#Tuple elements}]] - (untemplated_tuple @composite untemplated replace? subst elements)} - [replace? token])) - -(def-3 .public Primitive - Macro - (macro (_ tokens) - ({{#Item [_ {#Text class_name}] {#End}} - (meta#in (list (variant$ (list (symbol$ [..prelude "#Primitive"]) (text$ class_name) |#End|)))) + [_ [@composite {#Variant elements}]] + (untemplated_variant @composite untemplated replace? subst elements) - {#Item [_ {#Text class_name}] {#Item [_ {#Tuple params}] {#End}}} - (meta#in (list (variant$ (list (symbol$ [..prelude "#Primitive"]) (text$ class_name) (untemplated_list params))))) + [_ [@composite {#Tuple elements}]] + (untemplated_tuple @composite untemplated replace? subst elements)} + [replace? token])) - _ - (failure "Wrong syntax for Primitive")} - tokens))) +(def' .public Primitive + Macro + (macro (_ tokens) + ({{#Item [_ {#Text class_name}] {#End}} + (meta#in (list (variant$ (list (symbol$ [..prelude "#Primitive"]) (text$ class_name) |#End|)))) + + {#Item [_ {#Text class_name}] {#Item [_ {#Tuple params}] {#End}}} + (meta#in (list (variant$ (list (symbol$ [..prelude "#Primitive"]) (text$ class_name) (untemplated_list params))))) -(def-3 .public ` - Macro + _ + (failure (wrong_syntax_error [..prelude "Primitive"]))} + tokens))) + +(def' .public ` + Macro + (macro (_ tokens) + ({{#Item template {#End}} + (do meta#monad + [current_module current_module_name + =template (untemplated #1 current_module template)] + (in (list (form$ (list (text$ "lux type check") + (symbol$ [..prelude "Code"]) + =template))))) + + _ + (failure (wrong_syntax_error [..prelude "`"]))} + tokens))) + +(def' .public `' + Macro + (macro (_ tokens) + ({{#Item template {#End}} + (do meta#monad + [=template (untemplated #1 "" template)] + (in (list (form$ (list (text$ "lux type check") (symbol$ [..prelude "Code"]) =template))))) + + _ + (failure (wrong_syntax_error [..prelude "`'"]))} + tokens))) + +(def' .public ' + Macro + (macro (_ tokens) + ({{#Item template {#End}} + (do meta#monad + [=template (untemplated #0 "" template)] + (in (list (form$ (list (text$ "lux type check") (symbol$ [..prelude "Code"]) =template))))) + + _ + (failure (wrong_syntax_error [..prelude "'"]))} + tokens))) + +(def' .public ~ + UnQuote + (..unquote (macro (_ tokens) - ({{#Item template {#End}} - (do meta#monad - [current_module current_module_name - =template (untemplated #1 current_module template)] - (in (list (form$ (list (text$ "lux type check") - (symbol$ [..prelude "Code"]) - =template))))) + ({{#Item it {#End}} + (meta#in (list (form$ (list (text$ "lux type check") + (symbol$ [..prelude "Code"]) + it)))) _ - (failure "Wrong syntax for `")} - tokens))) + (failure (wrong_syntax_error [..prelude "~"]))} + tokens)))) -(def-3 .public `' - Macro +(def' .public ~! + UnQuote + (..unquote (macro (_ tokens) - ({{#Item template {#End}} + ({{#Item [@token dependent] {#End}} (do meta#monad - [=template (untemplated #1 "" template)] - (in (list (form$ (list (text$ "lux type check") (symbol$ [..prelude "Code"]) =template))))) + [current_module ..current_module_name + independent (untemplated #1 current_module [@token dependent])] + (in (list (with_location @token (variant$ (list (symbol$ [..prelude "#Form"]) + (untemplated_list (list (untemplated_text dummy_location "lux in-module") + (untemplated_text dummy_location current_module) + independent)))))))) _ - (failure "Wrong syntax for `'")} - tokens))) + (failure (wrong_syntax_error [..prelude "~!"]))} + tokens)))) -(def-3 .public ' - Macro +(def' .public ~' + UnQuote + (..unquote (macro (_ tokens) - ({{#Item template {#End}} + ({{#Item it {#End}} (do meta#monad - [=template (untemplated #0 "" template)] - (in (list (form$ (list (text$ "lux type check") (symbol$ [..prelude "Code"]) =template))))) + [current_module ..current_module_name + it (untemplated #0 current_module it)] + (in (list it))) _ - (failure "Wrong syntax for '")} - tokens))) - -(def-3 .public ~ - UnQuote - (..unquote - (macro (_ tokens) - ({{#Item it {#End}} - (meta#in (list (form$ (list (text$ "lux type check") - (symbol$ [..prelude "Code"]) - it)))) + (failure (wrong_syntax_error [..prelude "~'"]))} + tokens)))) + +(def' .public ~+ + Spliced_UnQuote + (let' [g!list#composite (form$ (list (text$ "lux in-module") + (text$ ..prelude) + (symbol$ [..prelude "list#composite"])))] + (..spliced_unquote + (macro (_ tokens) + ({{#Item tail {#Item it {#End}}} + (meta#in (list (form$ (list g!list#composite (|List<Code>| it) tail)))) + + _ + (failure (wrong_syntax_error [..prelude "~+"]))} + tokens))))) + +(def' .public |> + Macro + (macro (_ tokens) + ({{#Item [init apps]} + (meta#in (list (list#mix ("lux type check" (-> Code Code Code) + (function' [app acc] + ({[_ {#Variant parts}] + (variant$ (list#composite parts (list acc))) + + [_ {#Tuple parts}] + (tuple$ (list#composite parts (list acc))) + + [_ {#Form parts}] + (form$ (list#composite parts (list acc))) + + _ + (` ((~ app) (~ acc)))} + app))) + init + apps))) - _ - (failure (wrong_syntax_error [..prelude "~"]))} - tokens)))) - -(def-3 .public ~! - UnQuote - (..unquote - (macro (_ tokens) - ({{#Item dependent {#End}} - (do meta#monad - [current_module ..current_module_name - independent (untemplated #1 current_module dependent)] - (in (list (with_location (variant$ (list (symbol$ [..prelude "#Form"]) - (untemplated_list (list (untemplated_text "lux in-module") - (untemplated_text current_module) - independent)))))))) - - _ - (failure (wrong_syntax_error [..prelude "~!"]))} - tokens)))) - -(def-3 .public ~' - UnQuote - (..unquote - (macro (_ tokens) - ({{#Item it {#End}} - (do meta#monad - [current_module ..current_module_name - it (untemplated #0 current_module it)] - (in (list it))) - - _ - (failure (wrong_syntax_error [..prelude "~'"]))} - tokens)))) - -(def-3 .public ~+ - Spliced_UnQuote - (let' [g!list#composite (form$ (list (text$ "lux in-module") - (text$ ..prelude) - (symbol$ [..prelude "list#composite"])))] - (..spliced_unquote - (macro (_ tokens) - ({{#Item tail {#Item it {#End}}} - (meta#in (list (form$ (list g!list#composite (|List<Code>| it) tail)))) - - _ - (failure (wrong_syntax_error [..prelude "~+"]))} - tokens))))) - -(def-3 .public |> - Macro - (macro (_ tokens) - ({{#Item [init apps]} - (meta#in (list (list#mix ("lux type check" (-> Code Code Code) - (function' [app acc] - ({[_ {#Variant parts}] - (variant$ (list#composite parts (list acc))) + _ + (failure (wrong_syntax_error [..prelude "|>"]))} + tokens))) + +(def' .public <| + Macro + (macro (_ tokens) + ({{#Item [init apps]} + (meta#in (list (list#mix ("lux type check" (-> Code Code Code) + (function' [app acc] + ({[_ {#Variant parts}] + (variant$ (list#composite parts (list acc))) + + [_ {#Tuple parts}] + (tuple$ (list#composite parts (list acc))) + + [_ {#Form parts}] + (form$ (list#composite parts (list acc))) + + _ + (` ((~ app) (~ acc)))} + app))) + init + apps))) - [_ {#Tuple parts}] - (tuple$ (list#composite parts (list acc))) + _ + (failure (wrong_syntax_error [..prelude "<|"]))} + (list#reversed tokens)))) - [_ {#Form parts}] - (form$ (list#composite parts (list acc))) +(def' .private (function#composite f g) + (All (_ a b c) + (-> (-> b c) (-> a b) (-> a c))) + (function' [x] (f (g x)))) - _ - (` ((~ app) (~ acc)))} - app))) - init - apps))) +(def' .private (symbol_name x) + (-> Code ($' Maybe Symbol)) + ({[_ {#Symbol sname}] + {#Some sname} - _ - (failure "Wrong syntax for |>")} - tokens))) + _ + {#None}} + x)) -(def-3 .public <| - Macro - (macro (_ tokens) - ({{#Item [init apps]} - (meta#in (list (list#mix ("lux type check" (-> Code Code Code) - (function' [app acc] - ({[_ {#Variant parts}] - (variant$ (list#composite parts (list acc))) +(def' .private (symbol_short x) + (-> Code ($' Maybe Text)) + ({[_ {#Symbol "" sname}] + {#Some sname} - [_ {#Tuple parts}] - (tuple$ (list#composite parts (list acc))) + _ + {#None}} + x)) - [_ {#Form parts}] - (form$ (list#composite parts (list acc))) +(def' .private (tuple_list tuple) + (-> Code ($' Maybe ($' List Code))) + ({[_ {#Tuple members}] + {#Some members} - _ - (` ((~ app) (~ acc)))} - app))) - init - apps))) + _ + {#None}} + tuple)) - _ - (failure "Wrong syntax for <|")} - (list#reversed tokens)))) +(def' .private (realized_template env template) + (-> Replacement_Environment Code Code) + ({[_ {#Symbol "" sname}] + ({{#Some subst} + subst -(def-2 .private (function#composite f g) - (All (_ a b c) - (-> (-> b c) (-> a b) (-> a c))) - (function' [x] (f (g x)))) + _ + template} + (..replacement sname env)) -(def-2 .private (symbol_name x) - (-> Code ($' Maybe Symbol)) - ({[_ {#Symbol sname}] - {#Some sname} + [meta {#Form elems}] + [meta {#Form (list#each (realized_template env) elems)}] - _ - {#None}} - x)) + [meta {#Tuple elems}] + [meta {#Tuple (list#each (realized_template env) elems)}] -(def-2 .private (symbol_short x) - (-> Code ($' Maybe Text)) - ({[_ {#Symbol "" sname}] - {#Some sname} + [meta {#Variant elems}] + [meta {#Variant (list#each (realized_template env) elems)}] - _ - {#None}} - x)) + _ + template} + template)) + +(def' .private (high_bits value) + (-> ($' I64 Any) I64) + ("lux i64 right-shift" 32 value)) + +(def' .private low_mask + I64 + (|> 1 ("lux i64 left-shift" 32) ("lux i64 -" 1))) + +(def' .private (low_bits value) + (-> ($' I64 Any) I64) + ("lux i64 and" low_mask value)) + +(def' .private (n/< reference sample) + (-> Nat Nat Bit) + (let' [referenceH (high_bits reference) + sampleH (high_bits sample)] + (if ("lux i64 <" referenceH sampleH) + #1 + (if ("lux i64 =" referenceH sampleH) + ("lux i64 <" + (low_bits reference) + (low_bits sample)) + #0)))) + +(def' .private (list#conjoint xs) + (All (_ a) + (-> ($' List ($' List a)) ($' List a))) + (list#mix list#composite {#End} (list#reversed xs))) + +(def' .public with_template + Macro + (macro (_ tokens) + ({{#Item [[_ {#Tuple bindings}] {#Item [[_ {#Tuple templates}] data]}]} + ({[{#Some bindings'} {#Some data'}] + (let' [apply ("lux type check" (-> Replacement_Environment ($' List Code)) + (function' [env] (list#each (realized_template env) templates))) + num_bindings (list#size bindings')] + (if (every? (function' [size] ("lux i64 =" num_bindings size)) + (list#each list#size data')) + (|> data' + (list#each (function#composite apply (replacement_environment bindings'))) + list#conjoint + meta#in) + (failure (..wrong_syntax_error [..prelude "with_template"])))) -(def-2 .private (tuple_list tuple) - (-> Code ($' Maybe ($' List Code))) - ({[_ {#Tuple members}] - {#Some members} + _ + (failure (..wrong_syntax_error [..prelude "with_template"]))} + [(monad#each maybe#monad symbol_short bindings) + (monad#each maybe#monad tuple_list data)]) - _ - {#None}} - tuple)) + _ + (failure (..wrong_syntax_error [..prelude "with_template"]))} + tokens))) + +(def' .private (n// param subject) + (-> Nat Nat Nat) + (if ("lux i64 <" +0 ("lux type as" Int param)) + (if (n/< param subject) + 0 + 1) + (let' [quotient (|> subject + ("lux i64 right-shift" 1) + ("lux i64 /" ("lux type as" Int param)) + ("lux i64 left-shift" 1)) + flat ("lux i64 *" + ("lux type as" Int param) + ("lux type as" Int quotient)) + remainder ("lux i64 -" flat subject)] + (if (n/< param remainder) + quotient + ("lux i64 +" 1 quotient))))) + +(def' .private (n/% param subject) + (-> Nat Nat Nat) + (let' [flat ("lux i64 *" + ("lux type as" Int param) + ("lux type as" Int (n// param subject)))] + ("lux i64 -" flat subject))) + +(def' .private (n/min left right) + (-> Nat Nat Nat) + (if (n/< right left) + left + right)) + +(def' .private (bit#encoded x) + (-> Bit Text) + (if x "#1" "#0")) + +(def' .private (digit::format digit) + (-> Nat Text) + ({[0] "0" + [1] "1" [2] "2" [3] "3" + [4] "4" [5] "5" [6] "6" + [7] "7" [8] "8" [9] "9" + _ ("lux io error" "@digit::format Undefined behavior.")} + digit)) + +(def' .private (nat#encoded value) + (-> Nat Text) + ({[0] "0" + _ (let' [loop ("lux type check" (-> Nat Text Text) + (function' again [input output] + (if ("lux i64 =" 0 input) + output + (again (n// 10 input) + (text#composite (|> input (n/% 10) digit::format) + output)))))] + (loop value ""))} + value)) + +(def' .private (int#abs value) + (-> Int Int) + (if ("lux i64 <" +0 value) + ("lux i64 *" -1 value) + value)) -(def-2 .private (realized_template env template) - (-> Replacement_Environment Code Code) - ({[_ {#Symbol "" sname}] - ({{#Some subst} - subst +(def' .private (int#encoded value) + (-> Int Text) + (if ("lux i64 =" +0 value) + "+0" + (let' [sign (if ("lux i64 <" value +0) + "+" + "-")] + (("lux type check" (-> Int Text Text) + (function' again [input output] + (if ("lux i64 =" +0 input) + (text#composite sign output) + (again ("lux i64 /" +10 input) + (text#composite (|> input ("lux i64 %" +10) ("lux type as" Nat) digit::format) + output))))) + (|> value ("lux i64 /" +10) int#abs) + (|> value ("lux i64 %" +10) int#abs ("lux type as" Nat) digit::format))))) + +(def' .private (frac#encoded x) + (-> Frac Text) + ("lux f64 encode" x)) + +(def' .public (not x) + (-> Bit Bit) + (if x #0 #1)) + +(def' .private (macro_type? type) + (-> Type Bit) + ({{#Named ["library/lux" "Macro"] {#Primitive "#Macro" {#End}}} + #1 - _ - template} - (..replacement sname env)) + _ + #0} + type)) + +(def' .private (named_macro' modules current_module module name) + (-> ($' List (Tuple Text Module)) + Text Text Text + ($' Maybe Macro)) + (do maybe#monad + [$module (plist#value module modules) + gdef (let' [[..#module_hash _ ..#module_aliases _ ..#definitions bindings ..#imports _ ..#module_state _] ("lux type check" Module $module)] + (plist#value name bindings))] + ({{#Alias [r_module r_name]} + (named_macro' modules current_module r_module r_name) - [meta {#Form elems}] - [meta {#Form (list#each (realized_template env) elems)}] + {#Definition [exported? def_type def_value]} + (if (macro_type? def_type) + (if exported? + {#Some ("lux type as" Macro def_value)} + (if (text#= module current_module) + {#Some ("lux type as" Macro def_value)} + {#None})) + {#None}) - [meta {#Tuple elems}] - [meta {#Tuple (list#each (realized_template env) elems)}] + {#Type [exported? type labels]} + {#None} - [meta {#Variant elems}] - [meta {#Variant (list#each (realized_template env) elems)}] + {#Tag _} + {#None} - _ - template} - template)) - -(def-2 .private (high_bits value) - (-> ($' I64 Any) I64) - ("lux i64 right-shift" 32 value)) - -(def-2 .private low_mask - I64 - (|> 1 ("lux i64 left-shift" 32) ("lux i64 -" 1))) - -(def-2 .private (low_bits value) - (-> ($' I64 Any) I64) - ("lux i64 and" low_mask value)) - -(def-2 .private (n/< reference sample) - (-> Nat Nat Bit) - (let' [referenceH (high_bits reference) - sampleH (high_bits sample)] - (if ("lux i64 <" referenceH sampleH) - #1 - (if ("lux i64 =" referenceH sampleH) - ("lux i64 <" - (low_bits reference) - (low_bits sample)) - #0)))) - -(def-2 .private (list#conjoint xs) - (All (_ a) - (-> ($' List ($' List a)) ($' List a))) - (list#mix list#composite {#End} (list#reversed xs))) + {#Slot _} + {#None}} + ("lux type check" Global gdef)))) -(def-3 .public with_template - Macro - (macro (_ tokens) - ({{#Item [[_ {#Tuple bindings}] {#Item [[_ {#Tuple templates}] data]}]} - ({[{#Some bindings'} {#Some data'}] - (let' [apply ("lux type check" (-> Replacement_Environment ($' List Code)) - (function' [env] (list#each (realized_template env) templates))) - num_bindings (list#size bindings')] - (if (every? (function' [size] ("lux i64 =" num_bindings size)) - (list#each list#size data')) - (|> data' - (list#each (function#composite apply (replacement_environment bindings'))) - list#conjoint - meta#in) - (failure (..wrong_syntax_error [..prelude "with_template"])))) - - _ - (failure (..wrong_syntax_error [..prelude "with_template"]))} - [(monad#each maybe#monad symbol_short bindings) - (monad#each maybe#monad tuple_list data)]) +(def' .private (named_macro full_name) + (-> Symbol ($' Meta ($' Maybe Macro))) + (do meta#monad + [current_module current_module_name] + (let' [[module name] full_name] + (function' [state] + ({[..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected + ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] + {#Right state (named_macro' modules current_module module name)}} + state))))) + +(def' .private (macro? name) + (-> Symbol ($' Meta Bit)) + (do meta#monad + [name (normal name) + output (named_macro name)] + (in ({{#Some _} #1 + {#None} #0} + output)))) + +(def' .private (list#interposed sep xs) + (All (_ a) + (-> a ($' List a) ($' List a))) + ({{#End} + xs + + {#Item [x {#End}]} + xs + + {#Item [x xs']} + (partial_list x sep (list#interposed sep xs'))} + xs)) + +(def' .private (single_expansion token) + (-> Code ($' Meta ($' List Code))) + ({[_ {#Form {#Item [_ {#Symbol name}] args}}] + (do meta#monad + [name' (normal name) + ?macro (named_macro name')] + ({{#Some macro} + (("lux type as" Macro' macro) args) + + {#None} + (in (list token))} + ?macro)) - _ - (failure (..wrong_syntax_error [..prelude "with_template"]))} - tokens))) - -(def-2 .private (n// param subject) - (-> Nat Nat Nat) - (if ("lux i64 <" +0 ("lux type as" Int param)) - (if (n/< param subject) - 0 - 1) - (let' [quotient (|> subject - ("lux i64 right-shift" 1) - ("lux i64 /" ("lux type as" Int param)) - ("lux i64 left-shift" 1)) - flat ("lux i64 *" - ("lux type as" Int param) - ("lux type as" Int quotient)) - remainder ("lux i64 -" flat subject)] - (if (n/< param remainder) - quotient - ("lux i64 +" 1 quotient))))) - -(def-2 .private (n/% param subject) - (-> Nat Nat Nat) - (let' [flat ("lux i64 *" - ("lux type as" Int param) - ("lux type as" Int (n// param subject)))] - ("lux i64 -" flat subject))) - -(def-2 .private (n/min left right) - (-> Nat Nat Nat) - (if (n/< right left) - left - right)) - -(def-2 .private (bit#encoded x) - (-> Bit Text) - (if x "#1" "#0")) - -(def-2 .private (digit::format digit) - (-> Nat Text) - ({[0] "0" - [1] "1" [2] "2" [3] "3" - [4] "4" [5] "5" [6] "6" - [7] "7" [8] "8" [9] "9" - _ ("lux io error" "@digit::format Undefined behavior.")} - digit)) - -(def-2 .private (nat#encoded value) - (-> Nat Text) - ({[0] "0" - _ (let' [loop ("lux type check" (-> Nat Text Text) - (function' again [input output] - (if ("lux i64 =" 0 input) - output - (again (n// 10 input) - (text#composite (|> input (n/% 10) digit::format) - output)))))] - (loop value ""))} - value)) + _ + (meta#in (list token))} + token)) -(def-2 .private (int#abs value) - (-> Int Int) - (if ("lux i64 <" +0 value) - ("lux i64 *" -1 value) - value)) - -(def-2 .private (int#encoded value) - (-> Int Text) - (if ("lux i64 =" +0 value) - "+0" - (let' [sign (if ("lux i64 <" value +0) - "+" - "-")] - (("lux type check" (-> Int Text Text) - (function' again [input output] - (if ("lux i64 =" +0 input) - (text#composite sign output) - (again ("lux i64 /" +10 input) - (text#composite (|> input ("lux i64 %" +10) ("lux type as" Nat) digit::format) - output))))) - (|> value ("lux i64 /" +10) int#abs) - (|> value ("lux i64 %" +10) int#abs ("lux type as" Nat) digit::format))))) - -(def-2 .private (frac#encoded x) - (-> Frac Text) - ("lux f64 encode" x)) - -(def-2 .public (not x) - (-> Bit Bit) - (if x #0 #1)) - -(def-2 .private (macro_type? type) - (-> Type Bit) - ({{#Named ["library/lux" "Macro"] {#Primitive "#Macro" {#End}}} - #1 +(def' .private (expansion token) + (-> Code ($' Meta ($' List Code))) + ({[_ {#Form {#Item [_ {#Symbol name}] args}}] + (do meta#monad + [name' (normal name) + ?macro (named_macro name')] + ({{#Some macro} + (do meta#monad + [top_level_expansion (("lux type as" Macro' macro) args) + recursive_expansion (monad#each meta#monad expansion top_level_expansion)] + (in (list#conjoint recursive_expansion))) + + {#None} + (in (list token))} + ?macro)) - _ - #0} - type)) - -(def-2 .private (named_macro' modules current_module module name) - (-> ($' List (Tuple Text Module)) - Text Text Text - ($' Maybe Macro)) - (do maybe#monad - [$module (plist#value module modules) - gdef (let' [[..#module_hash _ ..#module_aliases _ ..#definitions bindings ..#imports _ ..#module_state _] ("lux type check" Module $module)] - (plist#value name bindings))] - ({{#Alias [r_module r_name]} - (named_macro' modules current_module r_module r_name) - - {#Definition [exported? def_type def_value]} - (if (macro_type? def_type) - (if exported? - {#Some ("lux type as" Macro def_value)} - (if (text#= module current_module) - {#Some ("lux type as" Macro def_value)} - {#None})) - {#None}) - - {#Type [exported? type labels]} - {#None} + _ + (meta#in (list token))} + token)) - {#Tag _} - {#None} +(def' .private (full_expansion' full_expansion name args) + (-> (-> Code ($' Meta ($' List Code))) Symbol ($' List Code) ($' Meta ($' List Code))) + (do meta#monad + [name' (normal name) + ?macro (named_macro name')] + ({{#Some macro} + (do meta#monad + [expansion (("lux type as" Macro' macro) args) + expansion' (monad#each meta#monad full_expansion expansion)] + (in (list#conjoint expansion'))) + + {#None} + (do meta#monad + [args' (monad#each meta#monad full_expansion args)] + (in (list (form$ {#Item (symbol$ name) (list#conjoint args')}))))} + ?macro))) + +(def' .private (in_module module meta) + (All (_ a) + (-> Text ($' Meta a) ($' Meta a))) + (function' [lux] + ({[..#info info ..#source source + ..#current_module current_module ..#modules modules + ..#scopes scopes ..#type_context type_context + ..#host host ..#seed seed + ..#expected expected ..#location location + ..#extensions extensions ..#scope_type_vars scope_type_vars + ..#eval eval] + ({{#Left error} + {#Left error} + + {#Right [[..#info info' ..#source source' + ..#current_module _ ..#modules modules' + ..#scopes scopes' ..#type_context type_context' + ..#host host' ..#seed seed' + ..#expected expected' ..#location location' + ..#extensions extensions' ..#scope_type_vars scope_type_vars' + ..#eval eval'] + output]} + {#Right [[..#info info' ..#source source' + ..#current_module current_module ..#modules modules' + ..#scopes scopes' ..#type_context type_context' + ..#host host' ..#seed seed' + ..#expected expected' ..#location location' + ..#extensions extensions' ..#scope_type_vars scope_type_vars' + ..#eval eval'] + output]}} + (meta [..#info info ..#source source + ..#current_module {.#Some module} ..#modules modules + ..#scopes scopes ..#type_context type_context + ..#host host ..#seed seed + ..#expected expected ..#location location + ..#extensions extensions ..#scope_type_vars scope_type_vars + ..#eval eval]))} + lux))) + +(def' .private (full_expansion expand_in_module?) + (-> Bit Code ($' Meta ($' List Code))) + (function' again [syntax] + ({[_ {#Form {#Item head tail}}] + ({[_ {#Form {#Item [_ {#Text "lux in-module"}] + {#Item [_ {#Text module}] + {#Item [_ {#Symbol name}] + {#End}}}}}] + (if expand_in_module? + (..in_module module (..full_expansion' again name tail)) + (do meta#monad + [members' (monad#each meta#monad again {#Item head tail})] + (in (list (form$ (list#conjoint members')))))) + + [_ {#Symbol name}] + (..full_expansion' again name tail) - {#Slot _} - {#None}} - ("lux type check" Global gdef)))) + _ + (do meta#monad + [members' (monad#each meta#monad again {#Item head tail})] + (in (list (form$ (list#conjoint members')))))} + head) -(def-2 .private (named_macro full_name) - (-> Symbol ($' Meta ($' Maybe Macro))) - (do meta#monad - [current_module current_module_name] - (let' [[module name] full_name] - (function' [state] - ({[..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected - ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] - {#Right state (named_macro' modules current_module module name)}} - state))))) - -(def-2 .private (macro? name) - (-> Symbol ($' Meta Bit)) - (do meta#monad - [name (normal name) - output (named_macro name)] - (in ({{#Some _} #1 - {#None} #0} - output)))) + [_ {#Variant members}] + (do meta#monad + [members' (monad#each meta#monad again members)] + (in (list (variant$ (list#conjoint members'))))) -(def-2 .private (list#interposed sep xs) - (All (_ a) - (-> a ($' List a) ($' List a))) - ({{#End} - xs - - {#Item [x {#End}]} - xs - - {#Item [x xs']} - (partial_list x sep (list#interposed sep xs'))} - xs)) - -(def-2 .private (single_expansion token) - (-> Code ($' Meta ($' List Code))) - ({[_ {#Form {#Item [_ {#Symbol name}] args}}] - (do meta#monad - [name' (normal name) - ?macro (named_macro name')] - ({{#Some macro} - (("lux type as" Macro' macro) args) - - {#None} - (in (list token))} - ?macro)) + [_ {#Tuple members}] + (do meta#monad + [members' (monad#each meta#monad again members)] + (in (list (tuple$ (list#conjoint members'))))) - _ - (meta#in (list token))} - token)) - -(def-2 .private (expansion token) - (-> Code ($' Meta ($' List Code))) - ({[_ {#Form {#Item [_ {#Symbol name}] args}}] - (do meta#monad - [name' (normal name) - ?macro (named_macro name')] - ({{#Some macro} - (do meta#monad - [top_level_expansion (("lux type as" Macro' macro) args) - recursive_expansion (monad#each meta#monad expansion top_level_expansion)] - (in (list#conjoint recursive_expansion))) - - {#None} - (in (list token))} - ?macro)) + _ + (meta#in (list syntax))} + syntax))) - _ - (meta#in (list token))} - token)) +(def' .private (text#encoded original) + (-> Text Text) + (all text#composite ..double_quote original ..double_quote)) -(def-2 .private (full_expansion' full_expansion name args) - (-> (-> Code ($' Meta ($' List Code))) Symbol ($' List Code) ($' Meta ($' List Code))) - (do meta#monad - [name' (normal name) - ?macro (named_macro name')] - ({{#Some macro} - (do meta#monad - [expansion (("lux type as" Macro' macro) args) - expansion' (monad#each meta#monad full_expansion expansion)] - (in (list#conjoint expansion'))) - - {#None} - (do meta#monad - [args' (monad#each meta#monad full_expansion args)] - (in (list (form$ {#Item (symbol$ name) (list#conjoint args')}))))} - ?macro))) +(def' .private (code#encoded code) + (-> Code Text) + ({[_ {#Bit value}] + (bit#encoded value) -(def-2 .private (in_module module meta) - (All (_ a) - (-> Text ($' Meta a) ($' Meta a))) - (function' [lux] - ({[..#info info ..#source source - ..#current_module current_module ..#modules modules - ..#scopes scopes ..#type_context type_context - ..#host host ..#seed seed - ..#expected expected ..#location location - ..#extensions extensions ..#scope_type_vars scope_type_vars - ..#eval eval] - ({{#Left error} - {#Left error} - - {#Right [[..#info info' ..#source source' - ..#current_module _ ..#modules modules' - ..#scopes scopes' ..#type_context type_context' - ..#host host' ..#seed seed' - ..#expected expected' ..#location location' - ..#extensions extensions' ..#scope_type_vars scope_type_vars' - ..#eval eval'] - output]} - {#Right [[..#info info' ..#source source' - ..#current_module current_module ..#modules modules' - ..#scopes scopes' ..#type_context type_context' - ..#host host' ..#seed seed' - ..#expected expected' ..#location location' - ..#extensions extensions' ..#scope_type_vars scope_type_vars' - ..#eval eval'] - output]}} - (meta [..#info info ..#source source - ..#current_module {.#Some module} ..#modules modules - ..#scopes scopes ..#type_context type_context - ..#host host ..#seed seed - ..#expected expected ..#location location - ..#extensions extensions ..#scope_type_vars scope_type_vars - ..#eval eval]))} - lux))) - -(def-2 .private (full_expansion expand_in_module?) - (-> Bit Code ($' Meta ($' List Code))) - (function' again [syntax] - ({[_ {#Form {#Item head tail}}] - ({[_ {#Form {#Item [_ {#Text "lux in-module"}] - {#Item [_ {#Text module}] - {#Item [_ {#Symbol name}] - {#End}}}}}] - (if expand_in_module? - (..in_module module (..full_expansion' again name tail)) - (do meta#monad - [members' (monad#each meta#monad again {#Item head tail})] - (in (list (form$ (list#conjoint members')))))) - - [_ {#Symbol name}] - (..full_expansion' again name tail) - - _ - (do meta#monad - [members' (monad#each meta#monad again {#Item head tail})] - (in (list (form$ (list#conjoint members')))))} - head) - - [_ {#Variant members}] - (do meta#monad - [members' (monad#each meta#monad again members)] - (in (list (variant$ (list#conjoint members'))))) - - [_ {#Tuple members}] - (do meta#monad - [members' (monad#each meta#monad again members)] - (in (list (tuple$ (list#conjoint members'))))) + [_ {#Nat value}] + (nat#encoded value) - _ - (meta#in (list syntax))} - syntax))) + [_ {#Int value}] + (int#encoded value) -(def-2 .private (text#encoded original) - (-> Text Text) - (all text#composite ..double_quote original ..double_quote)) + [_ {#Rev value}] + ("lux io error" "@code#encoded Undefined behavior.") + + [_ {#Frac value}] + (frac#encoded value) -(def-2 .private (code#encoded code) - (-> Code Text) - ({[_ {#Bit value}] - (bit#encoded value) + [_ {#Text value}] + (text#encoded value) + + [_ {#Symbol [module name]}] + (symbol#encoded [module name]) + + [_ {#Form xs}] + (all text#composite "(" (|> xs + (list#each code#encoded) + (list#interposed " ") + list#reversed + (list#mix text#composite "")) ")") + + [_ {#Tuple xs}] + (all text#composite "[" (|> xs + (list#each code#encoded) + (list#interposed " ") + list#reversed + (list#mix text#composite "")) "]") + + [_ {#Variant xs}] + (all text#composite "{" (|> xs + (list#each code#encoded) + (list#interposed " ") + list#reversed + (list#mix text#composite "")) "}")} + code)) + +(def' .private (normal_type type) + (-> Code ($' Meta Code)) + ({[_ {#Variant {#Item [_ {#Symbol symbol}] parts}}] + (do meta#monad + [parts (monad#each meta#monad normal_type parts)] + (in (` {(~ (symbol$ symbol)) (~+ parts)}))) - [_ {#Nat value}] - (nat#encoded value) + [_ {#Tuple members}] + (do meta#monad + [members (monad#each meta#monad normal_type members)] + (in (` (Tuple (~+ members))))) - [_ {#Int value}] - (int#encoded value) + [_ {#Form {#Item [_ {#Text "lux in-module"}] + {#Item [_ {#Text module}] + {#Item type' + {#End}}}}}] + (do meta#monad + [type' (normal_type type')] + (in (` ("lux in-module" (~ (text$ module)) (~ type'))))) - [_ {#Rev value}] - ("lux io error" "@code#encoded Undefined behavior.") - - [_ {#Frac value}] - (frac#encoded value) + [_ {#Form {#Item [_ {#Symbol ["" "~"]}] {#Item expression {#End}}}}] + (meta#in expression) - [_ {#Text value}] - (text#encoded value) - - [_ {#Symbol [module name]}] - (symbol#encoded [module name]) - - [_ {#Form xs}] - (all text#composite "(" (|> xs - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite "")) ")") - - [_ {#Tuple xs}] - (all text#composite "[" (|> xs - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite "")) "]") - - [_ {#Variant xs}] - (all text#composite "{" (|> xs - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite "")) "}")} - code)) - -(def-2 .private (normal_type type) - (-> Code Code) - ({[_ {#Variant {#Item [_ {#Symbol symbol}] parts}}] - (` {(~ (symbol$ symbol)) (~+ (list#each normal_type parts))}) - - [_ {#Tuple members}] - (` (Tuple (~+ (list#each normal_type members)))) - - [_ {#Form {#Item [_ {#Text "lux in-module"}] - {#Item [_ {#Text module}] - {#Item type' - {#End}}}}}] - (` ("lux in-module" (~ (text$ module)) (~ (normal_type type')))) - - [_ {#Form {#Item [_ {#Symbol ["" "~"]}] {#Item expression {#End}}}}] - expression - - [_0 {#Form {#Item [_1 {#Variant {#Item binding {#Item body {#End}}}}] - {#Item value - {#End}}}}] - [_0 {#Form {#Item [_1 {#Variant {#Item binding {#Item (normal_type body) {#End}}}}] - {#Item value - {#End}}}}] - - [_0 {#Form {#Item [_1 {#Symbol ["library/lux" "__adjusted_quantified_type__"]}] - {#Item _permission - {#Item _level - {#Item body - {#End}}}}}}] - [_0 {#Form {#Item [_1 {#Symbol [..prelude "__adjusted_quantified_type__"]}] - {#Item _permission - {#Item _level - {#Item (normal_type body) - {#End}}}}}}] - - [_ {#Form {#Item type_fn args}}] - (list#mix ("lux type check" (-> Code Code Code) - (function' [arg type_fn] (` {.#Apply (~ arg) (~ type_fn)}))) - (normal_type type_fn) - (list#each normal_type args)) + [_0 {#Form {#Item [_1 {#Variant {#Item binding {#Item body {#End}}}}] + {#Item value + {#End}}}}] + (do meta#monad + [body (normal_type body)] + (in [_0 {#Form {#Item [_1 {#Variant {#Item binding {#Item body {#End}}}}] + {#Item value + {#End}}}}])) + + [_0 {#Form {#Item [_1 {#Symbol ["library/lux" "__adjusted_quantified_type__"]}] + {#Item _permission + {#Item _level + {#Item body + {#End}}}}}}] + (do meta#monad + [body (normal_type body)] + (in [_0 {#Form {#Item [_1 {#Symbol [..prelude "__adjusted_quantified_type__"]}] + {#Item _permission + {#Item _level + {#Item body + {#End}}}}}}])) + + [_ {#Form {#Item type_fn args}}] + (do meta#monad + [type_fn (normal_type type_fn) + args (monad#each meta#monad normal_type args)] + (in (list#mix ("lux type check" (-> Code Code Code) + (function' [arg type_fn] (` {.#Apply (~ arg) (~ type_fn)}))) + type_fn + args))) - _ - type} - type)) + _ + (meta#in type)} + type)) -(def-3 .public type_literal - Macro - (macro (_ tokens) - ({{#Item type {#End}} - (do meta#monad - [initialized_quantification? (function' [lux] {#Right [lux (initialized_quantification? lux)]})] - (if initialized_quantification? - (do meta#monad - [type+ (full_expansion #0 type)] - ({{#Item type' {#End}} - (in (list (normal_type type'))) +(def' .public type_literal + Macro + (macro (_ tokens) + ({{#Item type {#End}} + (do meta#monad + [initialized_quantification? (function' [lux] {#Right [lux (initialized_quantification? lux)]})] + (if initialized_quantification? + (do meta#monad + [type+ (full_expansion #0 type)] + ({{#Item type' {#End}} + (do meta#monad + [type'' (normal_type type')] + (in (list type''))) - _ - (failure "The expansion of the type-syntax had to yield a single element.")} - type+)) - (in (list (..quantified (` (..type_literal (~ type)))))))) + _ + (failure "The expansion of the type-syntax had to yield a single element.")} + type+)) + (in (list (..quantified (` (..type_literal (~ type)))))))) - _ - (failure "Wrong syntax for type")} - tokens))) + _ + (failure (wrong_syntax_error [..prelude "type"]))} + tokens))) -(def-3 .public is - Macro - (macro (_ tokens) - ({{#Item type {#Item value {#End}}} - (meta#in (list (` ("lux type check" - (..type_literal (~ type)) - (~ value))))) +(def' .public is + Macro + (macro (_ tokens) + ({{#Item type {#Item value {#End}}} + (meta#in (list (` ("lux type check" + (..type_literal (~ type)) + (~ value))))) - _ - (failure "Wrong syntax for :")} - tokens))) + _ + (failure (wrong_syntax_error [..prelude "is"]))} + tokens))) -(def-3 .public as - Macro - (macro (_ tokens) - ({{#Item type {#Item value {#End}}} - (meta#in (list (` ("lux type as" - (..type_literal (~ type)) - (~ value))))) +(def' .public as + Macro + (macro (_ tokens) + ({{#Item type {#Item value {#End}}} + (meta#in (list (` ("lux type as" + (..type_literal (~ type)) + (~ value))))) - _ - (failure "Wrong syntax for as")} - tokens))) + _ + (failure (wrong_syntax_error [..prelude "as"]))} + tokens))) -(def-2 .private (empty? xs) - (All (_ a) - (-> ($' List a) Bit)) - ({{#End} #1 - _ #0} - xs)) +(def' .private (empty? xs) + (All (_ a) + (-> ($' List a) Bit)) + ({{#End} #1 + _ #0} + xs)) (with_template [<name> <type> <value>] - [(def-2 .private (<name> xy) - (All (_ a b) - (-> (Tuple a b) <type>)) - (let' [[x y] xy] - <value>))] + [(def' .private (<name> xy) + (All (_ a b) + (-> (Tuple a b) <type>)) + (let' [[x y] xy] + <value>))] [product#left a x] [product#right b y]) -(def-2 .private (generated_symbol prefix state) - (-> Text ($' Meta Code)) - ({[..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected - ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] - {#Right [..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed ("lux i64 +" 1 seed) ..#expected expected - ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] - (local$ (all text#composite "__gensym__" prefix (nat#encoded seed)))}} - state)) - -(def-3 .public exec - Macro - (macro (_ tokens) - ({{#Item value actions} - (let' [dummy (local$ "")] - (meta#in (list (list#mix ("lux type check" (-> Code Code Code) - (function' [pre post] (` ({(~ dummy) (~ post)} - (~ pre))))) - value - actions)))) - - _ - (failure "Wrong syntax for exec")} - (list#reversed tokens)))) - -(def-3 .private def-1 - Macro - (macro (_ tokens) - (let' [parts (is (Maybe [Code Code (List Code) (Maybe Code) Code]) - ({{#Item export_policy {#Item [_ {#Form {#Item name args}}] {#Item type {#Item body {#End}}}}} - {#Some [export_policy name args {#Some type} body]} - - {#Item export_policy {#Item name {#Item type {#Item body {#End}}}}} - {#Some [export_policy name {#End} {#Some type} body]} - - {#Item export_policy {#Item [_ {#Form {#Item name args}}] {#Item body {#End}}}} - {#Some [export_policy name args {#None} body]} - - {#Item export_policy {#Item name {#Item body {#End}}}} - {#Some [export_policy name {#End} {#None} body]} +(def' .private (generated_symbol prefix state) + (-> Text ($' Meta Code)) + ({[..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected + ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] + {#Right [..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed ("lux i64 +" 1 seed) ..#expected expected + ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] + (local$ (all text#composite "__gensym__" prefix (nat#encoded seed)))}} + state)) + +(def' .public exec + Macro + (macro (_ tokens) + ({{#Item value actions} + (let' [dummy (local$ "")] + (meta#in (list (list#mix ("lux type check" (-> Code Code Code) + (function' [pre post] (` ({(~ dummy) (~ post)} + (~ pre))))) + value + actions)))) - _ - {#None}} - tokens))] - ({{#Some [export_policy name args ?type body]} - (let' [body' ({{#End} + _ + (failure "Wrong syntax for exec")} + (list#reversed tokens)))) + +(def' .private (case_expansion branches) + (type_literal (-> (List Code) (Meta (List Code)))) + ({{#Item [_ {#Form {#Item [_ {#Symbol name}] args}}] + {#Item body + branches'}} + (do meta#monad + [??? (macro? name)] + (if ??? + (do meta#monad + [init_expansion (single_expansion (form$ (partial_list (symbol$ name) (form$ args) body branches')))] + (case_expansion init_expansion)) + (do meta#monad + [sub_expansion (case_expansion branches')] + (in (partial_list (form$ (partial_list (symbol$ name) args)) body + sub_expansion))))) - _ - (` (function' (~ name) [(~+ args)] (~ body)))} - args) - body'' ({{#Some type} - (` (is (~ type) (~ body'))) - - {#None} - body'} - ?type)] - (meta#in (list (` ("lux def" (~ name) - (~ body'') - (~ export_policy)))))) - - {#None} - (failure "Wrong syntax for def-1")} - parts)))) - -(def-1 .private (case_expansion branches) - (-> (List Code) (Meta (List Code))) - ({{#Item [_ {#Form {#Item [_ {#Symbol name}] args}}] - {#Item body - branches'}} - (do meta#monad - [??? (macro? name)] - (if ??? - (do meta#monad - [init_expansion (single_expansion (form$ (partial_list (symbol$ name) (form$ args) body branches')))] - (case_expansion init_expansion)) - (do meta#monad - [sub_expansion (case_expansion branches')] - (in (partial_list (form$ (partial_list (symbol$ name) args)) - body - sub_expansion))))) - - {#Item pattern {#Item body branches'}} - (do meta#monad - [sub_expansion (case_expansion branches')] - (in (partial_list pattern body sub_expansion))) - - {#End} - (do meta#monad [] (in (list))) - - _ - (failure (all text#composite "'lux.case' expects an even number of tokens: " (|> branches - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite ""))))} - branches)) - -(def-3 .public case - Macro - (macro (_ tokens) - ({{#Item value branches} - (do meta#monad - [expansion (case_expansion branches)] - (in (list (` ((~ (variant$ expansion)) (~ value)))))) - - _ - (failure "Wrong syntax for case")} - tokens))) - -(def-3 .public pattern - Macro - (macro (_ tokens) - (case tokens - {#Item [_ {#Form {#Item pattern {#End}}}] {#Item body branches}} - (do meta#monad - [pattern+ (full_expansion #1 pattern)] - (case pattern+ - {#Item pattern' {#End}} - (in (partial_list pattern' body branches)) - - _ - (failure "`pattern` can only expand to 1 pattern."))) - - _ - (failure "Wrong syntax for `pattern` macro")))) + {#Item pattern {#Item body branches'}} + (do meta#monad + [sub_expansion (case_expansion branches')] + (in (partial_list pattern body sub_expansion))) -(def-3 .private pattern#or - Macro - (macro (_ tokens) - (case tokens - (pattern (partial_list [_ {#Form patterns}] body branches)) - (case patterns - {#End} - (failure "pattern#or cannot have 0 patterns") - - _ - (let' [pairs (|> patterns - (list#each (function' [pattern] (list pattern body))) - (list#conjoint))] - (meta#in (list#composite pairs branches)))) - _ - (failure "Wrong syntax for pattern#or")))) + {#End} + (do meta#monad [] (in (list))) -(def-3 .public symbol - Macro - (macro (_ tokens) - (case tokens - (pattern (list [_ {#Symbol [module name]}])) - (meta#in (list (` [(~ (text$ module)) (~ (text$ name))]))) - - _ - (failure (..wrong_syntax_error [..prelude "symbol"]))))) + _ + (failure (all text#composite "'lux.case' expects an even number of tokens: " (|> branches + (list#each code#encoded) + (list#interposed " ") + list#reversed + (list#mix text#composite ""))))} + branches)) + +(def' .public case + Macro + (macro (_ tokens) + ({{#Item value branches} + (do meta#monad + [expansion (case_expansion branches)] + (in (list (` ((~ (variant$ expansion)) (~ value)))))) -(def-1 .private (symbol? code) - (-> Code Bit) - (case code - [_ {#Symbol _}] - #1 + _ + (failure "Wrong syntax for case")} + tokens))) + +(def' .public pattern + Macro + (macro (_ tokens) + (case tokens + {#Item [_ {#Form {#Item pattern {#End}}}] {#Item body branches}} + (do meta#monad + [pattern+ (full_expansion #1 pattern)] + (case pattern+ + {#Item pattern' {#End}} + (in (partial_list pattern' body branches)) + + _ + (failure "`pattern` can only expand to 1 pattern."))) + + _ + (failure "Wrong syntax for `pattern` macro")))) + +(def' .private pattern#or + Macro + (macro (_ tokens) + (case tokens + (pattern (partial_list [_ {#Form patterns}] body branches)) + (case patterns + {#End} + (failure "pattern#or cannot have 0 patterns") - _ - #0)) + _ + (let' [pairs (|> patterns + (list#each (function' [pattern] (list pattern body))) + (list#conjoint))] + (meta#in (list#composite pairs branches)))) + _ + (failure "Wrong syntax for pattern#or")))) + +(def' .public symbol + Macro + (macro (_ tokens) + (case tokens + (pattern (list [_ {#Symbol [module name]}])) + (meta#in (list (` [(~ (text$ module)) (~ (text$ name))]))) + + _ + (failure (..wrong_syntax_error [..prelude "symbol"]))))) -(def-3 .public let - Macro - (macro (_ tokens) - (case tokens - (pattern (list [_ {#Tuple bindings}] body)) - (case (..pairs bindings) - {#Some bindings} - (|> bindings - list#reversed - (list#mix (is (-> [Code Code] Code Code) - (function' [lr body'] - (let' [[l r] lr] - (if (symbol? l) - (` ({(~ l) (~ body')} (~ r))) - (` (case (~ r) (~ l) (~ body'))))))) - body) - list - meta#in) - - {#None} - (failure "let requires an even number of parts")) +(def' .private (symbol? code) + (type_literal (-> Code Bit)) + (case code + [_ {#Symbol _}] + #1 - _ - (failure (..wrong_syntax_error (symbol ..let)))))) + _ + #0)) + +(def' .public let + Macro + (macro (_ tokens) + (case tokens + (pattern (list [_ {#Tuple bindings}] body)) + (case (..pairs bindings) + {#Some bindings} + (|> bindings + list#reversed + (list#mix (is (-> [Code Code] Code Code) + (function' [lr body'] + (let' [[l r] lr] + (if (symbol? l) + (` ({(~ l) (~ body')} (~ r))) + (` (case (~ r) (~ l) (~ body'))))))) + body) + list + meta#in) + + {#None} + (failure "let requires an even number of parts")) -(def-3 .public function - Macro - (macro (_ tokens) - (case (is (Maybe [Text Code (List Code) Code]) - (case tokens - (pattern (list [_ {#Form (partial_list [_ {#Symbol ["" name]}] head tail)}] body)) - {#Some name head tail body} - - _ - {#None})) - {#Some g!name head tail body} - (let [g!blank (local$ "") - nest (is (-> Code (-> Code Code Code)) - (function' [g!name] - (function' [arg body'] - (if (symbol? arg) - (` ([(~ g!name) (~ arg)] (~ body'))) - (` ([(~ g!name) (~ g!blank)] - (.case (~ g!blank) (~ arg) (~ body'))))))))] - (meta#in (list (nest (..local$ g!name) head - (list#mix (nest g!blank) body (list#reversed tail)))))) + _ + (failure (..wrong_syntax_error (symbol ..let)))))) + +(def' .public function + Macro + (macro (_ tokens) + (case (is (Maybe [Text Code (List Code) Code]) + (case tokens + (pattern (list [_ {#Form (partial_list [_ {#Symbol ["" name]}] head tail)}] body)) + {#Some name head tail body} + + _ + {#None})) + {#Some g!name head tail body} + (let [g!blank (local$ "") + nest (is (-> Code (-> Code Code Code)) + (function' [g!name] + (function' [arg body'] + (if (symbol? arg) + (` ([(~ g!name) (~ arg)] (~ body'))) + (` ([(~ g!name) (~ g!blank)] + (.case (~ g!blank) (~ arg) (~ body'))))))))] + (meta#in (list (nest (..local$ g!name) head + (list#mix (nest g!blank) body (list#reversed tail)))))) - {#None} - (failure (..wrong_syntax_error (symbol ..function)))))) + {#None} + (failure (..wrong_syntax_error (symbol ..function)))))) -(def-1 .private Parser - Type - {#Named [..prelude "Parser"] - (..type_literal (All (_ a) - (-> (List Code) (Maybe [(List Code) a]))))}) +(def' .private Parser + Type + {#Named [..prelude "Parser"] + (..type_literal (All (_ a) + (-> (List Code) (Maybe [(List Code) a]))))}) -(def-1 .private (parsed parser tokens) - (All (_ a) (-> (Parser a) (List Code) (Maybe a))) - (case (parser tokens) - (pattern {#Some [(list) it]}) - {#Some it} +(def' .private (parsed parser tokens) + (type_literal (All (_ a) (-> (Parser a) (List Code) (Maybe a)))) + (case (parser tokens) + (pattern {#Some [(list) it]}) + {#Some it} - _ - {#None})) + _ + {#None})) -(def-1 .private (inP it tokens) +(def' .private (inP it tokens) + (type_literal (All (_ a) - (-> a (Parser a))) - {#Some [tokens it]}) + (-> a (Parser a)))) + {#Some [tokens it]}) -(def-1 .private (orP leftP rightP tokens) +(def' .private (orP leftP rightP tokens) + (type_literal (All (_ l r) (-> (Parser l) (Parser r) - (Parser (Or l r)))) - (case (leftP tokens) - {#Some [tokens left]} - {#Some [tokens {#Left left}]} + (Parser (Or l r))))) + (case (leftP tokens) + {#Some [tokens left]} + {#Some [tokens {#Left left}]} - _ - (case (rightP tokens) - {#Some [tokens right]} - {#Some [tokens {#Right right}]} + _ + (case (rightP tokens) + {#Some [tokens right]} + {#Some [tokens {#Right right}]} - _ - {#None}))) + _ + {#None}))) -(def-1 .private (eitherP leftP rightP tokens) +(def' .private (eitherP leftP rightP tokens) + (type_literal (All (_ a) (-> (Parser a) (Parser a) - (Parser a))) - (case (leftP tokens) - {#None} - (rightP tokens) + (Parser a)))) + (case (leftP tokens) + {#None} + (rightP tokens) - it - it)) + it + it)) -(def-1 .private (andP leftP rightP tokens) +(def' .private (andP leftP rightP tokens) + (type_literal (All (_ l r) (-> (Parser l) (Parser r) - (Parser [l r]))) - (do maybe#monad - [left (leftP tokens) - .let [[tokens left] left] - right (rightP tokens) - .let [[tokens right] right]] - (in [tokens [left right]]))) - -(def-1 .private (afterP leftP rightP tokens) + (Parser [l r])))) + (do maybe#monad + [left (leftP tokens) + .let [[tokens left] left] + right (rightP tokens) + .let [[tokens right] right]] + (in [tokens [left right]]))) + +(def' .private (afterP leftP rightP tokens) + (type_literal (All (_ l r) (-> (Parser l) (Parser r) - (Parser r))) - (do maybe#monad - [left (leftP tokens) - .let [[tokens left] left]] - (rightP tokens))) - -(def-1 .private (someP itP tokens) + (Parser r)))) + (do maybe#monad + [left (leftP tokens) + .let [[tokens left] left]] + (rightP tokens))) + +(def' .private (someP itP tokens) + (type_literal (All (_ a) (-> (Parser a) - (Parser (List a)))) - (case (itP tokens) - {#Some [tokens head]} - (do maybe#monad - [it (someP itP tokens) - .let [[tokens tail] it]] - (in [tokens (partial_list head tail)])) + (Parser (List a))))) + (case (itP tokens) + {#Some [tokens head]} + (do maybe#monad + [it (someP itP tokens) + .let [[tokens tail] it]] + (in [tokens (partial_list head tail)])) - {#None} - {#Some [tokens (list)]})) + {#None} + {#Some [tokens (list)]})) -(def-1 .private (manyP itP tokens) +(def' .private (manyP itP tokens) + (type_literal (All (_ a) (-> (Parser a) - (Parser (List a)))) - (do maybe#monad - [it (itP tokens) - .let [[tokens head] it] - it (someP itP tokens) - .let [[tokens tail] it]] - (in [tokens (partial_list head tail)]))) - -(def-1 .private (maybeP itP tokens) + (Parser (List a))))) + (do maybe#monad + [it (itP tokens) + .let [[tokens head] it] + it (someP itP tokens) + .let [[tokens tail] it]] + (in [tokens (partial_list head tail)]))) + +(def' .private (maybeP itP tokens) + (type_literal (All (_ a) (-> (Parser a) - (Parser (Maybe a)))) - (case (itP tokens) - {#Some [tokens it]} - {#Some [tokens {#Some it}]} + (Parser (Maybe a))))) + (case (itP tokens) + {#Some [tokens it]} + {#Some [tokens {#Some it}]} - {#None} - {#Some [tokens {#None}]})) + {#None} + {#Some [tokens {#None}]})) -(def-1 .private (tupleP itP tokens) +(def' .private (tupleP itP tokens) + (type_literal (All (_ a) - (-> (Parser a) (Parser a))) - (case tokens - (pattern (partial_list [_ {#Tuple input}] tokens')) - (do maybe#monad - [it (parsed itP input)] - (in [tokens' it])) + (-> (Parser a) (Parser a)))) + (case tokens + (pattern (partial_list [_ {#Tuple input}] tokens')) + (do maybe#monad + [it (parsed itP input)] + (in [tokens' it])) - _ - {#None})) + _ + {#None})) -(def-1 .private (formP itP tokens) +(def' .private (formP itP tokens) + (type_literal (All (_ a) - (-> (Parser a) (Parser a))) - (case tokens - (pattern (partial_list [_ {#Form input}] tokens')) - (do maybe#monad - [it (parsed itP input)] - (in [tokens' it])) + (-> (Parser a) (Parser a)))) + (case tokens + (pattern (partial_list [_ {#Form input}] tokens')) + (do maybe#monad + [it (parsed itP input)] + (in [tokens' it])) - _ - {#None})) + _ + {#None})) -(def-1 .private (bindingP tokens) - (Parser [Text Code]) - (case tokens - (pattern (partial_list [_ {#Symbol ["" name]}] value &rest)) - {#Some [&rest [name value]]} +(def' .private (bindingP tokens) + (type_literal (Parser [Text Code])) + (case tokens + (pattern (partial_list [_ {#Symbol ["" name]}] value &rest)) + {#Some [&rest [name value]]} - _ - {#None})) + _ + {#None})) -(def-1 .private (endP tokens) - (Parser Any) - (case tokens - (pattern (list)) - {#Some [tokens []]} +(def' .private (endP tokens) + (type_literal (Parser Any)) + (case tokens + (pattern (list)) + {#Some [tokens []]} - _ - {#None})) + _ + {#None})) -(def-1 .private (anyP tokens) - (Parser Code) - (case tokens - (pattern (partial_list code tokens')) - {#Some [tokens' code]} +(def' .private (anyP tokens) + (type_literal (Parser Code)) + (case tokens + (pattern (partial_list code tokens')) + {#Some [tokens' code]} - _ - {#None})) + _ + {#None})) -(def-1 .private (localP tokens) - (-> (List Code) (Maybe [(List Code) Text])) - (case tokens - (pattern (partial_list [_ {#Symbol ["" local]}] tokens')) - {#Some [tokens' local]} +(def' .private (localP tokens) + (type_literal (-> (List Code) (Maybe [(List Code) Text]))) + (case tokens + (pattern (partial_list [_ {#Symbol ["" local]}] tokens')) + {#Some [tokens' local]} - _ - {#None})) + _ + {#None})) -(def-1 .private (symbolP tokens) - (-> (List Code) (Maybe [(List Code) Symbol])) - (case tokens - (pattern (partial_list [_ {#Symbol it}] tokens')) - {#Some [tokens' it]} +(def' .private (symbolP tokens) + (type_literal (-> (List Code) (Maybe [(List Code) Symbol]))) + (case tokens + (pattern (partial_list [_ {#Symbol it}] tokens')) + {#Some [tokens' it]} - _ - {#None})) + _ + {#None})) (with_template [<parser> <item_type> <item_parser>] - [(def-1 .private (<parser> tokens) - (-> (List Code) (Maybe (List <item_type>))) - (case tokens - {#End} - {#Some {#End}} + [(def' .private (<parser> tokens) + (type_literal (-> (List Code) (Maybe (List <item_type>)))) + (case tokens + {#End} + {#Some {#End}} - _ - (do maybe#monad - [% (<item_parser> tokens) - .let' [[tokens head] %] - tail (<parser> tokens)] - (in {#Item head tail}))))] + _ + (do maybe#monad + [% (<item_parser> tokens) + .let' [[tokens head] %] + tail (<parser> tokens)] + (in {#Item head tail}))))] [parametersP Text localP] [enhanced_parametersP Code anyP] ) (with_template [<parser> <parameter_type> <parameters_parser>] - [(def-1 .private (<parser> tokens) - (Parser [Text (List <parameter_type>)]) - (case tokens - (pattern (partial_list [_ {#Form local_declaration}] tokens')) - (do maybe#monad - [% (localP local_declaration) - .let' [[local_declaration name] %] - parameters (<parameters_parser> local_declaration)] - (in [tokens' [name parameters]])) - - _ - (do maybe#monad - [% (localP tokens) - .let' [[tokens' name] %]] - (in [tokens' [name {#End}]]))))] + [(def' .private (<parser> tokens) + (type_literal (Parser [Text (List <parameter_type>)])) + (case tokens + (pattern (partial_list [_ {#Form local_declaration}] tokens')) + (do maybe#monad + [% (localP local_declaration) + .let' [[local_declaration name] %] + parameters (<parameters_parser> local_declaration)] + (in [tokens' [name parameters]])) + + _ + (do maybe#monad + [% (localP tokens) + .let' [[tokens' name] %]] + (in [tokens' [name {#End}]]))))] [local_declarationP Text parametersP] [enhanced_local_declarationP Code enhanced_parametersP] ) -(def-1 .private (export_policyP tokens) - (-> (List Code) [(List Code) Code]) - (case tokens - (pattern (partial_list candidate tokens')) - (case candidate - [_ {#Bit it}] - [tokens' candidate] - - [_ {#Symbol ["" _]}] - [tokens (` .private)] - - [_ {#Symbol it}] - [tokens' candidate] +(def' .private (export_policyP tokens) + (type_literal (-> (List Code) [(List Code) Code])) + (case tokens + (pattern (partial_list candidate tokens')) + (case candidate + [_ {#Bit it}] + [tokens' candidate] + + [_ {#Symbol ["" _]}] + [tokens (` .private)] + + [_ {#Symbol it}] + [tokens' candidate] - _ - [tokens (` .private)]) + _ + [tokens (` .private)]) - _ - [tokens (` .private)])) + _ + [tokens (` .private)])) (with_template [<parser> <parameter_type> <local>] - [(def-1 .private (<parser> tokens) - (-> (List Code) (Maybe [(List Code) [Code Text (List <parameter_type>)]])) - (do maybe#monad - [.let' [[tokens export_policy] (export_policyP tokens)] - % (<local> tokens) - .let' [[tokens [name parameters]] %]] - (in [tokens [export_policy name parameters]])))] + [(def' .private (<parser> tokens) + (type_literal (-> (List Code) (Maybe [(List Code) [Code Text (List <parameter_type>)]]))) + (do maybe#monad + [.let' [[tokens export_policy] (export_policyP tokens)] + % (<local> tokens) + .let' [[tokens [name parameters]] %]] + (in [tokens [export_policy name parameters]])))] [declarationP Text local_declarationP] [enhanced_declarationP Code enhanced_local_declarationP] ) -(def-1 .private (bodyP tokens) - (-> (List Code) (Maybe [(List Code) [(Maybe Code) Code]])) - (case tokens - ... TB - (pattern (partial_list type body tokens')) - {#Some [tokens' [{#Some type} body]]} +(def' .private (bodyP tokens) + (type_literal (-> (List Code) (Maybe [(List Code) [(Maybe Code) Code]]))) + (case tokens + ... TB + (pattern (partial_list type body tokens')) + {#Some [tokens' [{#Some type} body]]} - ... B - (pattern (partial_list body tokens')) - {#Some [tokens' [{#None} body]]} + ... B + (pattern (partial_list body tokens')) + {#Some [tokens' [{#None} body]]} - _ - {#None})) - -(def-1 .private (definitionP tokens) - (-> (List Code) (Maybe [Code Text (List Code) (Maybe Code) Code])) - (do maybe#monad - [% (enhanced_declarationP tokens) - .let' [[tokens [export_policy name parameters]] %] - % (bodyP tokens) - .let' [[tokens [?type body]] %] - _ (endP tokens)] - (in [export_policy name parameters ?type body]))) - -(def-3 .public def - Macro - (macro (_ tokens) - (case (definitionP tokens) - {#Some [export_policy name parameters ?type body]} - (let [body (case parameters - {#End} - body - - _ - (` (function ((~ (..local$ name)) (~+ parameters)) - (~ body)))) - body (case ?type - {#Some type} - (` (is (~ type) - (~ body))) - - {#None} - body)] - (meta#in (list (` ("lux def" (~ (..local$ name)) - (~ body) - (~ export_policy)))))) - - {#None} - (failure (..wrong_syntax_error (symbol ..def)))))) + _ + {#None})) + +(def' .private (definitionP tokens) + (type_literal (-> (List Code) (Maybe [Code Text (List Code) (Maybe Code) Code]))) + (do maybe#monad + [% (enhanced_declarationP tokens) + .let' [[tokens [export_policy name parameters]] %] + % (bodyP tokens) + .let' [[tokens [?type body]] %] + _ (endP tokens)] + (in [export_policy name parameters ?type body]))) + +(def' .public def + Macro + (macro (_ tokens) + (case (definitionP tokens) + {#Some [export_policy name parameters ?type body]} + (let [body (case parameters + {#End} + body + + _ + (` (function ((~ (..local$ name)) (~+ parameters)) + (~ body)))) + body (case ?type + {#Some type} + (` (is (~ type) + (~ body))) + + {#None} + body)] + (meta#in (list (` ("lux def" (~ (..local$ name)) + (~ body) + (~ export_policy)))))) + + {#None} + (failure (..wrong_syntax_error (symbol ..def)))))) (with_template [<name> <form> <message>] [(def .public <name> @@ -4104,12 +4086,12 @@ (def (definition_type name state) (-> Symbol Lux (Maybe Type)) - (let [[v_module v_name] name + (let [[expected_module expected_short] name [..#info info ..#source source ..#current_module _ ..#modules modules ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] state] - (case (plist#value v_module modules) + (case (plist#value expected_module modules) {#None} {#None} @@ -4118,7 +4100,7 @@ ..#module_aliases _ ..#imports _ ..#module_state _]} - (case (plist#value v_name definitions) + (case (plist#value expected_short definitions) {#None} {#None} @@ -5330,13 +5312,12 @@ _ (failure (..wrong_syntax_error (symbol ..``)))))) -(def .public false - Bit - #0) +(with_template [<bit> <name>] + [(def .public <name> Bit <bit>)] -(def .public true - Bit - #1) + [#0 false] + [#1 true] + ) (def .public try (macro (_ tokens) diff --git a/stdlib/source/library/lux/type/unit.lux b/stdlib/source/library/lux/type/unit.lux index e7327e551..994e7ad11 100644 --- a/stdlib/source/library/lux/type/unit.lux +++ b/stdlib/source/library/lux/type/unit.lux @@ -15,25 +15,25 @@ ["[0]" // (.only) [primitive (.except)]]) -(primitive .public (Qty scale unit) +(primitive .public (Measure scale unit) Int - (def .public quantity - (All (_ scale unit) (-> Int (Qty scale unit))) + (def .public measure + (All (_ scale unit) (-> Int (Measure scale unit))) (|>> abstraction)) (def .public number - (All (_ scale unit) (-> (Qty scale unit) Int)) + (All (_ scale unit) (-> (Measure scale unit) Int)) (|>> representation)) (def .public equivalence - (All (_ scale unit) (Equivalence (Qty scale unit))) + (All (_ scale unit) (Equivalence (Measure scale unit))) (implementation (def (= reference sample) (i.= (representation reference) (representation sample))))) (def .public order - (All (_ scale unit) (Order (Qty scale unit))) + (All (_ scale unit) (Order (Measure scale unit))) (implementation (def equivalence ..equivalence) @@ -41,7 +41,7 @@ (i.< (representation reference) (representation sample))))) (def .public enum - (All (_ scale unit) (Enum (Qty scale unit))) + (All (_ scale unit) (Enum (Measure scale unit))) (implementation (def order ..order) (def succ (|>> representation ++ abstraction)) @@ -49,7 +49,7 @@ (with_template [<name> <op>] [(def .public (<name> param subject) - (All (_ scale unit) (-> (Qty scale unit) (Qty scale unit) (Qty scale unit))) + (All (_ scale unit) (-> (Measure scale unit) (Measure scale unit) (Measure scale unit))) (abstraction (<op> (representation param) (representation subject))))] @@ -59,7 +59,7 @@ (with_template [<name> <op> <p> <s> <p*s>] [(def .public (<name> param subject) - (All (_ scale p s) (-> (Qty scale <p>) (Qty scale <s>) (Qty scale <p*s>))) + (All (_ scale p s) (-> (Measure scale <p>) (Measure scale <s>) (Measure scale <p*s>))) (abstraction (<op> (representation param) (representation subject))))] @@ -69,15 +69,15 @@ (.type .public (Unit a) (Interface - (is (-> Int (Qty Any a)) + (is (-> Int (Measure Any a)) in) - (is (-> (Qty Any a) Int) + (is (-> (Measure Any a) Int) out))) (def .public (unit _) (Ex (_ a) (-> Any (Unit a))) (implementation - (def in ..quantity) + (def in ..measure) (def out ..number))) ) diff --git a/stdlib/source/library/lux/type/unit/scale.lux b/stdlib/source/library/lux/type/unit/scale.lux index e88ee83e8..b7f598d13 100644 --- a/stdlib/source/library/lux/type/unit/scale.lux +++ b/stdlib/source/library/lux/type/unit/scale.lux @@ -15,9 +15,9 @@ (.type .public (Scale s) (Interface - (is (All (_ u) (-> (//.Qty Any u) (//.Qty s u))) + (is (All (_ u) (-> (//.Measure Any u) (//.Measure s u))) up) - (is (All (_ u) (-> (//.Qty s u) (//.Qty Any u))) + (is (All (_ u) (-> (//.Measure s u) (//.Measure Any u))) down) (is Ratio ratio))) @@ -30,24 +30,24 @@ (|>> //.number (i.* (.int /#numerator)) (i./ (.int /#denominator)) - //.quantity)) + //.measure)) (def down (|>> //.number (i.* (.int /#denominator)) (i./ (.int /#numerator)) - //.quantity)) + //.measure)) (def ratio ratio)))) -(def .public (re_scaled from to quantity) - (All (_ si so u) (-> (Scale si) (Scale so) (//.Qty si u) (//.Qty so u))) +(def .public (re_scaled from to measure) + (All (_ si so u) (-> (Scale si) (Scale so) (//.Measure si u) (//.Measure so u))) (let [(open "/[0]") (ratio./ (at from ratio) (at to ratio))] - (|> quantity + (|> measure //.number (i.* (.int /#numerator)) (i./ (.int /#denominator)) - //.quantity))) + //.measure))) (def .public type (syntax (_ [it <code>.any]) diff --git a/stdlib/source/polytypic/lux/abstract/equivalence.lux b/stdlib/source/polytypic/lux/abstract/equivalence.lux index 3d8497e87..4b50b9e2b 100644 --- a/stdlib/source/polytypic/lux/abstract/equivalence.lux +++ b/stdlib/source/polytypic/lux/abstract/equivalence.lux @@ -101,7 +101,7 @@ [month.Month month.equivalence] )) (do ! - [_ (<type>.applied (<>.and (<type>.exactly unit.Qty) + [_ (<type>.applied (<>.and (<type>.exactly unit.Measure) <type>.any))] (in (` (is (~ (@Equivalence inputT)) unit.equivalence)))) diff --git a/stdlib/source/polytypic/lux/data/format/json.lux b/stdlib/source/polytypic/lux/data/format/json.lux index 4d19b7a64..a177d5712 100644 --- a/stdlib/source/polytypic/lux/data/format/json.lux +++ b/stdlib/source/polytypic/lux/data/format/json.lux @@ -86,16 +86,16 @@ {.#None} {/.#Null} {.#Some value} (format value)))) -(def qty_codec +(def measure_codec (All (_ unit) - (codec.Codec JSON (unit.Qty unit))) + (codec.Codec JSON (unit.Measure unit))) (implementation (def encoded (|>> unit.number (at ..int_codec encoded))) (def decoded (|>> (at ..int_codec decoded) - (at try.functor each unit.quantity))))) + (at try.functor each unit.measure))))) (def encoded (polytypic encoded @@ -135,10 +135,10 @@ <basic> <time> (do ! - [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty) + [unitT (<type>.applied (<>.after (<type>.exactly unit.Measure) <type>.any))] (in (` (is (~ (@JSON#encoded inputT)) - (at (~! qty_codec) (~' encoded)))))) + (at (~! measure_codec) (~' encoded)))))) (do ! [.let [g!_ (code.local "_______") g!key (code.local "_______key") @@ -260,10 +260,10 @@ <basic> <time> (do ! - [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty) + [unitT (<type>.applied (<>.after (<type>.exactly unit.Measure) <type>.any))] (in (` (is (~ (@JSON#decoded inputT)) - ((~! <>.codec) (~! qty_codec) (~! </>.any)))))) + ((~! <>.codec) (~! measure_codec) (~! </>.any)))))) (do ! [[_ _ valC] (<type>.applied (all <>.and (<type>.exactly dictionary.Dictionary) diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 8116043d2..7be586b4f 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -212,7 +212,7 @@ ... #instant instant.Instant ... #duration duration.Duration #date date.Date - #grams (unit.Qty unit.Gram)])) + #grams (unit.Measure unit.Gram)])) (def gen_recursive (Random Recursive) @@ -222,9 +222,9 @@ (random.and random.safe_frac gen_recursive))))) -(def qty - (All (_ unit) (Random (unit.Qty unit))) - (at random.monad each unit.quantity random.int)) +(def measure + (All (_ unit) (Random (unit.Measure unit))) + (at random.monad each unit.measure random.int)) (def gen_record (Random Record) @@ -243,7 +243,7 @@ ... \\test/instant.instant ... \\test/duration.duration random.date - ..qty + ..measure ))) (for @.old (these) diff --git a/stdlib/source/test/lux/type/unit.lux b/stdlib/source/test/lux/type/unit.lux index 6835769ba..b52ddd921 100644 --- a/stdlib/source/test/lux/type/unit.lux +++ b/stdlib/source/test/lux/type/unit.lux @@ -20,7 +20,7 @@ (with_template [<name> <type> <unit>] [(def (<name> range) - (-> Nat (Random (/.Qty Any <type>))) + (-> Nat (Random (/.Measure Any <type>))) (|> random.int (at random.monad each (i.% (.int range))) (random.only (|>> (i.= +0) not)) @@ -62,15 +62,15 @@ [/.Litre /.litre] [/.Second /.second] )) - (_.coverage [/.quantity /.number] + (_.coverage [/.measure /.number] (|> expected - /.quantity + /.measure /.number (i.= expected))) (_.coverage [/.unit /.type] (|> expected (at ..what in) - (is (/.Qty Any What)) + (is (/.Measure Any What)) (at ..what out) (i.= expected))) ))))) @@ -79,7 +79,7 @@ Test (do random.monad [.let [zero (at /.meter in +0) - (open "meter#[0]") (is (Equivalence (/.Qty Any /.Meter)) + (open "meter#[0]") (is (Equivalence (/.Measure Any /.Meter)) /.equivalence)] left (random.only (|>> (meter#= zero) not) (..meter 1,000)) right (..meter 1,000) @@ -95,7 +95,7 @@ )) (_.coverage [/.*] (let [expected (i.* (at /.meter out left) (at /.meter out right)) - actual (/.number (is (/.Qty Any [/.Meter /.Meter]) + actual (/.number (is (/.Measure Any [/.Meter /.Meter]) (/.* left right)))] (i.= expected actual))) (_.coverage [/./] @@ -108,7 +108,7 @@ (def .public test Test (<| (_.covering /._) - (_.for [/.Qty]) + (_.for [/.Measure]) (all _.and ..polymorphism ..unit diff --git a/stdlib/source/test/lux/type/unit/scale.lux b/stdlib/source/test/lux/type/unit/scale.lux index aa5d6fc1a..adc3523b5 100644 --- a/stdlib/source/test/lux/type/unit/scale.lux +++ b/stdlib/source/test/lux/type/unit/scale.lux @@ -45,7 +45,7 @@ (at ! each (i.% +1,000)) (at ! each (i.* +1,000,000,000)) (at ! each (at //.meter in))) - .let [(open "meter#[0]") (is (Equivalence (//.Qty Any //.Meter)) + .let [(open "meter#[0]") (is (Equivalence (//.Measure Any //.Meter)) //.equivalence)] unscaled (|> random.int (at ! each (i.% +1,000)) @@ -56,9 +56,9 @@ [(_.coverage [<type> <scale>] (|> small (at <scale> up) - (is (//.Qty <type> //.Meter)) + (is (//.Measure <type> //.Meter)) (at <scale> down) - (is (//.Qty Any //.Meter)) + (is (//.Measure Any //.Meter)) (meter#= small)))] [/.Kilo /.kilo] @@ -69,9 +69,9 @@ [(_.coverage [<type> <scale>] (|> large (at <scale> up) - (is (//.Qty <type> //.Meter)) + (is (//.Measure <type> //.Meter)) (at <scale> down) - (is (//.Qty Any //.Meter)) + (is (//.Measure Any //.Meter)) (meter#= large)))] [/.Milli /.milli] @@ -79,16 +79,16 @@ [/.Nano /.nano] )) (_.coverage [/.re_scaled] - (|> large (is (//.Qty Any //.Meter)) - (at /.kilo up) (is (//.Qty /.Kilo //.Meter)) - (/.re_scaled /.kilo /.milli) (is (//.Qty /.Milli //.Meter)) - (/.re_scaled /.milli /.kilo) (is (//.Qty /.Kilo //.Meter)) - (at /.kilo down) (is (//.Qty Any //.Meter)) + (|> large (is (//.Measure Any //.Meter)) + (at /.kilo up) (is (//.Measure /.Kilo //.Meter)) + (/.re_scaled /.kilo /.milli) (is (//.Measure /.Milli //.Meter)) + (/.re_scaled /.milli /.kilo) (is (//.Measure /.Kilo //.Meter)) + (at /.kilo down) (is (//.Measure Any //.Meter)) (meter#= large))) (_.coverage [/.scale /.type] (and (|> unscaled (at ..how up) - (is (//.Qty How //.Meter)) + (is (//.Measure How //.Meter)) (at ..how down) (meter#= unscaled)) (ratio#= [ratio.#denominator ..how::from |