diff options
| author | Eduardo Julian | 2022-06-11 00:10:52 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2022-06-11 00:10:52 -0400 |
| commit | 5b36c00da8a21c5d70adec4b50ef573e12dc5cf8 (patch) | |
| tree | a1549d05cce57d20745c0835ea2419858fc30a4e | |
| parent | f21ca0dc1956a47b8f7ac6e0ea67d7d246c55280 (diff) | |
De-sigil-ification: : [Part 2]
125 files changed, 3203 insertions, 2980 deletions
diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el index 593eeb87b..ddaa4b6e2 100644 --- a/lux-mode/lux-mode.el +++ b/lux-mode/lux-mode.el @@ -399,7 +399,7 @@ Called by `imenu--generic-function'." (definition (altRE "\\.using" "def:" "type:" "program:" "inline:" "implementation:" - "macro" "syntax:" + "macro" "syntax" "exception:" "word:" "analysis:" "synthesis:" "generation:" "directive:"))) @@ -584,6 +584,7 @@ This function also returns nil meaning don't specify the indentation." (define-lux-indent (function 'defun) (macro 'defun) + ("syntax" 'defun) (import 'defun) (export 'defun) diff --git a/lux-r/source/program.lux b/lux-r/source/program.lux index 2f4fab588..1a61a8545 100644 --- a/lux-r/source/program.lux +++ b/lux-r/source/program.lux @@ -23,7 +23,7 @@ [collection ["[0]" array (.only Array)]]] ["[0]" macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" template] ["[0]" code]] [math @@ -186,8 +186,9 @@ ... (|>> (pipe.case #0 (org/armedbear/lisp/Nil::NIL) ... #1 (org/armedbear/lisp/Symbol::T)))) -(syntax: (%%code [term <code>.any]) - (wrap (list (code.text (%.code term))))) +(def: %%code + (syntax (_ [term <code>.any]) + (wrap (list (code.text (%.code term)))))) (def: (host_value value) (-> Any org/renjin/sexp/SEXP) diff --git a/lux-ruby/source/program.lux b/lux-ruby/source/program.lux index ca2a3247b..16fb31a96 100644 --- a/lux-ruby/source/program.lux +++ b/lux-ruby/source/program.lux @@ -26,7 +26,6 @@ ["[0]" array (.only Array)] ["[0]" list (.open: "[1]#[0]" functor)]]] ["[0]" macro - [syntax (.only syntax:)] ["^" pattern] ["[0]" template]] [math diff --git a/stdlib/source/documentation/lux/data/collection/array.lux b/stdlib/source/documentation/lux/data/collection/array.lux index 0c5013c8c..a6f4d203b 100644 --- a/stdlib/source/documentation/lux/data/collection/array.lux +++ b/stdlib/source/documentation/lux/data/collection/array.lux @@ -9,7 +9,6 @@ ["[0]" text (.only \n) ["%" format (.only format)]]] [macro - [syntax (.only syntax:)] ["[0]" code] ["[0]" template]]]] [\\library diff --git a/stdlib/source/documentation/lux/data/collection/bits.lux b/stdlib/source/documentation/lux/data/collection/bits.lux index c00811010..dc2f65a41 100644 --- a/stdlib/source/documentation/lux/data/collection/bits.lux +++ b/stdlib/source/documentation/lux/data/collection/bits.lux @@ -9,7 +9,6 @@ ["[0]" text (.only \n) ["%" format (.only format)]]] [macro - [syntax (.only syntax:)] ["[0]" code] ["[0]" template]]]] [\\library diff --git a/stdlib/source/documentation/lux/data/collection/dictionary.lux b/stdlib/source/documentation/lux/data/collection/dictionary.lux index fa324c8a7..784e39489 100644 --- a/stdlib/source/documentation/lux/data/collection/dictionary.lux +++ b/stdlib/source/documentation/lux/data/collection/dictionary.lux @@ -9,7 +9,6 @@ ["[0]" text (.only \n) ["%" format (.only format)]]] [macro - [syntax (.only syntax:)] ["[0]" code] ["[0]" template]]]] [\\library diff --git a/stdlib/source/documentation/lux/data/collection/dictionary/ordered.lux b/stdlib/source/documentation/lux/data/collection/dictionary/ordered.lux index 4ac9ea09e..0558eaed0 100644 --- a/stdlib/source/documentation/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/documentation/lux/data/collection/dictionary/ordered.lux @@ -9,7 +9,6 @@ ["[0]" text (.only \n) ["%" format (.only format)]]] [macro - [syntax (.only syntax:)] ["[0]" code] ["[0]" template]]]] [\\library diff --git a/stdlib/source/documentation/lux/data/collection/dictionary/plist.lux b/stdlib/source/documentation/lux/data/collection/dictionary/plist.lux index b257ffe2e..885176140 100644 --- a/stdlib/source/documentation/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/documentation/lux/data/collection/dictionary/plist.lux @@ -9,7 +9,6 @@ ["[0]" text (.only \n) ["%" format (.only format)]]] [macro - [syntax (.only syntax:)] ["[0]" code] ["[0]" template]]]] [\\library diff --git a/stdlib/source/documentation/lux/data/collection/list.lux b/stdlib/source/documentation/lux/data/collection/list.lux index a3084604c..28b8011f1 100644 --- a/stdlib/source/documentation/lux/data/collection/list.lux +++ b/stdlib/source/documentation/lux/data/collection/list.lux @@ -9,7 +9,6 @@ ["[0]" text (.only \n) ["%" format (.only format)]]] [macro - [syntax (.only syntax:)] ["[0]" code] ["[0]" template]]]] [\\library diff --git a/stdlib/source/documentation/lux/data/collection/queue.lux b/stdlib/source/documentation/lux/data/collection/queue.lux index cde4e7b66..04b1591f4 100644 --- a/stdlib/source/documentation/lux/data/collection/queue.lux +++ b/stdlib/source/documentation/lux/data/collection/queue.lux @@ -9,7 +9,6 @@ ["[0]" text (.only \n) ["%" format (.only format)]]] [macro - [syntax (.only syntax:)] ["[0]" code] ["[0]" template]]]] [\\library diff --git a/stdlib/source/documentation/lux/data/collection/queue/priority.lux b/stdlib/source/documentation/lux/data/collection/queue/priority.lux index 655387052..6b03ef53a 100644 --- a/stdlib/source/documentation/lux/data/collection/queue/priority.lux +++ b/stdlib/source/documentation/lux/data/collection/queue/priority.lux @@ -9,7 +9,6 @@ ["[0]" text (.only \n) ["%" format (.only format)]]] [macro - [syntax (.only syntax:)] ["[0]" code] ["[0]" template]]]] [\\library diff --git a/stdlib/source/documentation/lux/data/collection/sequence.lux b/stdlib/source/documentation/lux/data/collection/sequence.lux index 77ba80af0..996b1b225 100644 --- a/stdlib/source/documentation/lux/data/collection/sequence.lux +++ b/stdlib/source/documentation/lux/data/collection/sequence.lux @@ -9,7 +9,6 @@ ["[0]" text (.only \n) ["%" format (.only format)]]] [macro - [syntax (.only syntax:)] ["[0]" code] ["[0]" template]]]] [\\library diff --git a/stdlib/source/documentation/lux/data/collection/stream.lux b/stdlib/source/documentation/lux/data/collection/stream.lux index b1ada7c34..1ada33efa 100644 --- a/stdlib/source/documentation/lux/data/collection/stream.lux +++ b/stdlib/source/documentation/lux/data/collection/stream.lux @@ -9,7 +9,6 @@ ["[0]" text (.only \n) ["%" format (.only format)]]] [macro - [syntax (.only syntax:)] ["[0]" code] ["[0]" template]]]] [\\library diff --git a/stdlib/source/documentation/lux/data/color.lux b/stdlib/source/documentation/lux/data/color.lux index 43d878837..a3d452f5f 100644 --- a/stdlib/source/documentation/lux/data/color.lux +++ b/stdlib/source/documentation/lux/data/color.lux @@ -9,7 +9,7 @@ ["[0]" text (.only \n) ["%" format (.only format)]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code] ["[0]" template]]]] [\\library @@ -40,8 +40,9 @@ "" [(interpolated ratio end start)]) -(syntax: (palette_documentation [[_ name] <code>.symbol]) - (in (list (code.text (format "A " (text.replaced "_" "-" name) " palette."))))) +(def: palette_documentation + (syntax (_ [[_ name] <code>.symbol]) + (in (list (code.text (format "A " (text.replaced "_" "-" name) " palette.")))))) (documentation: /.analogous (palette_documentation /.analogous) diff --git a/stdlib/source/documentation/lux/data/color/named.lux b/stdlib/source/documentation/lux/data/color/named.lux index 6b62d598e..398a4d7ef 100644 --- a/stdlib/source/documentation/lux/data/color/named.lux +++ b/stdlib/source/documentation/lux/data/color/named.lux @@ -9,7 +9,6 @@ ["[0]" text ["%" format (.only format)]]] [macro - [syntax (.only syntax:)] ["[0]" code] ["[0]" template]] [math diff --git a/stdlib/source/documentation/lux/macro.lux b/stdlib/source/documentation/lux/macro.lux index 1e60483d6..d9968fe02 100644 --- a/stdlib/source/documentation/lux/macro.lux +++ b/stdlib/source/documentation/lux/macro.lux @@ -39,14 +39,15 @@ (documentation: /.with_symbols "Creates new symbols and offers them to the body expression." - [(syntax: (synchronized [lock any - body any]) - (with_symbols [g!lock g!body g!_] - (in (list (` (let [(~ g!lock) (~ lock) - (~ g!_) ("jvm monitorenter" (~ g!lock)) - (~ g!body) (~ body) - (~ g!_) ("jvm monitorexit" (~ g!lock))] - (~ g!body)))))))]) + [(def: synchronized + (syntax (_ [lock any + body any]) + (with_symbols [g!lock g!body g!_] + (in (list (` (let [(~ g!lock) (~ lock) + (~ g!_) ("jvm monitorenter" (~ g!lock)) + (~ g!body) (~ body) + (~ g!_) ("jvm monitorexit" (~ g!lock))] + (~ g!body))))))))]) (documentation: /.one_expansion "Works just like expand, except that it ensures that the output is a single Code token." diff --git a/stdlib/source/documentation/lux/macro/syntax.lux b/stdlib/source/documentation/lux/macro/syntax.lux index 525777d61..db6e4640d 100644 --- a/stdlib/source/documentation/lux/macro/syntax.lux +++ b/stdlib/source/documentation/lux/macro/syntax.lux @@ -18,29 +18,30 @@ [\\library ["[0]" /]]) -(documentation: /.syntax: +(documentation: /.syntax (format \n "A more advanced way to define macros than 'macro'." \n "The inputs to the macro can be parsed in complex ways through the use of syntax parsers." \n "The macro body is also (implicitly) run in the Meta monad, to save some typing." \n "Also, the compiler state can be accessed through a special binding.") - [(syntax: .public (object lux_state [.let [imports (class_imports lux_state)] - .let [class_vars (list)] - super (opt (super_class_decl^ imports class_vars)) - interfaces (tuple (some (super_class_decl^ imports class_vars))) - constructor_args (constructor_args^ imports class_vars) - methods (some (overriden_method_def^ imports))]) - (let [def_code (all text#composite "anon-class:" - (spaced (list (super_class_decl$ (maybe.else object_super_class super)) - (with_brackets (spaced (list#each super_class_decl$ interfaces))) - (with_brackets (spaced (list#each constructor_arg$ constructor_args))) - (with_brackets (spaced (list#each (method_def$ id) methods))))))] - (in (list (` ((~ (code.text def_code))))))))]) + [(def: .public object + (syntax (_ lux_state [.let [imports (class_imports lux_state)] + .let [class_vars (list)] + super (opt (super_class_decl^ imports class_vars)) + interfaces (tuple (some (super_class_decl^ imports class_vars))) + constructor_args (constructor_args^ imports class_vars) + methods (some (overriden_method_def^ imports))]) + (let [def_code (all text#composite "anon-class:" + (spaced (list (super_class_decl$ (maybe.else object_super_class super)) + (with_brackets (spaced (list#each super_class_decl$ interfaces))) + (with_brackets (spaced (list#each constructor_arg$ constructor_args))) + (with_brackets (spaced (list#each (method_def$ id) methods))))))] + (in (list (` ((~ (code.text def_code)))))))))]) (.def: .public documentation (.List $.Module) ($.module /._ "" - [..syntax:] + [..syntax] [/check.documentation /declaration.documentation /definition.documentation diff --git a/stdlib/source/library/lux/abstract/monad/indexed.lux b/stdlib/source/library/lux/abstract/monad/indexed.lux index 212b190f4..f1d774637 100644 --- a/stdlib/source/library/lux/abstract/monad/indexed.lux +++ b/stdlib/source/library/lux/abstract/monad/indexed.lux @@ -8,7 +8,7 @@ [collection ["[0]" list (.open: "[1]#[0]" functor mix)]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]]]] ["[0]" //]) @@ -61,33 +61,34 @@ (at <>.monad each (|>> [{.#None}]) <code>.any))) -(syntax: .public (do [[?name monad] ..named_monad - context (<code>.tuple (<>.some context)) - expression <code>.any]) - (macro.with_symbols [g!_ g!then] - (let [body (list#mix (function (_ context next) - (case context - {#Macro macro parameter} - (` ((~ (code.symbol macro)) - (~ parameter) - (~ next))) - - {#Binding [binding value]} - (` ((~ g!then) - (.function ((~ g!_) (~ binding)) - (~ next)) - (~ value))))) - expression - (list.reversed context))] - (in (list (case ?name - {.#Some name} - (let [name (code.local name)] - (` (let [(~ name) (~ monad) - [..in (~' in) - ..then (~ g!then)] (~ name)] - (~ body)))) +(def: .public do + (syntax (_ [[?name monad] ..named_monad + context (<code>.tuple (<>.some context)) + expression <code>.any]) + (macro.with_symbols [g!_ g!then] + (let [body (list#mix (function (_ context next) + (case context + {#Macro macro parameter} + (` ((~ (code.symbol macro)) + (~ parameter) + (~ next))) + + {#Binding [binding value]} + (` ((~ g!then) + (.function ((~ g!_) (~ binding)) + (~ next)) + (~ value))))) + expression + (list.reversed context))] + (in (list (case ?name + {.#Some name} + (let [name (code.local name)] + (` (let [(~ name) (~ monad) + [..in (~' in) + ..then (~ g!then)] (~ name)] + (~ body)))) - {.#None} - (` (let [[..in (~' in) - ..then (~ g!then)] (~ monad)] - (~ body))))))))) + {.#None} + (` (let [[..in (~' in) + ..then (~ g!then)] (~ monad)] + (~ body)))))))))) diff --git a/stdlib/source/library/lux/control/concatenative.lux b/stdlib/source/library/lux/control/concatenative.lux index a10e6e906..81a5af65d 100644 --- a/stdlib/source/library/lux/control/concatenative.lux +++ b/stdlib/source/library/lux/control/concatenative.lux @@ -14,7 +14,7 @@ ["[0]" macro (.only with_symbols) ["[0]" code] ["[0]" template] - [syntax (.only syntax:) + [syntax (.only syntax) ["|[0]|" export]]] [math [number @@ -79,30 +79,31 @@ (<>.either (all <>.and aliases^ stack^ stack^) (all <>.and (<>#in (list)) stack^ stack^))) -(syntax: .public (=> [[aliases inputs outputs] signature^]) - (let [de_alias (function (_ aliased) - (list#mix (function (_ [from to] pre) - (code.replaced (code.local from) to pre)) - aliased - aliases))] - (case [(the #bottom inputs) - (the #bottom outputs)] - [{.#Some bottomI} {.#Some bottomO}] - (monad.do meta.monad - [inputC (singleton (macro.full_expansion (stack_mix (the #top inputs) bottomI))) - outputC (singleton (macro.full_expansion (stack_mix (the #top outputs) bottomO)))] - (in (list (` (-> (~ (de_alias inputC)) - (~ (de_alias outputC))))))) - - [?bottomI ?bottomO] - (with_symbols [g!stack] +(def: .public => + (syntax (_ [[aliases inputs outputs] signature^]) + (let [de_alias (function (_ aliased) + (list#mix (function (_ [from to] pre) + (code.replaced (code.local from) to pre)) + aliased + aliases))] + (case [(the #bottom inputs) + (the #bottom outputs)] + [{.#Some bottomI} {.#Some bottomO}] (monad.do meta.monad - [inputC (singleton (macro.full_expansion (stack_mix (the #top inputs) (maybe.else g!stack ?bottomI)))) - outputC (singleton (macro.full_expansion (stack_mix (the #top outputs) (maybe.else g!stack ?bottomO))))] - (with_symbols [g!_] - (in (list (` (All ((~ g!_) (~ g!stack)) - (-> (~ (de_alias inputC)) - (~ (de_alias outputC))))))))))))) + [inputC (singleton (macro.full_expansion (stack_mix (the #top inputs) bottomI))) + outputC (singleton (macro.full_expansion (stack_mix (the #top outputs) bottomO)))] + (in (list (` (-> (~ (de_alias inputC)) + (~ (de_alias outputC))))))) + + [?bottomI ?bottomO] + (with_symbols [g!stack] + (monad.do meta.monad + [inputC (singleton (macro.full_expansion (stack_mix (the #top inputs) (maybe.else g!stack ?bottomI)))) + outputC (singleton (macro.full_expansion (stack_mix (the #top outputs) (maybe.else g!stack ?bottomO))))] + (with_symbols [g!_] + (in (list (` (All ((~ g!_) (~ g!stack)) + (-> (~ (de_alias inputC)) + (~ (de_alias outputC)))))))))))))) (def: beginning Any @@ -113,8 +114,9 @@ (function (_ [_ top]) top)) -(syntax: .public (||> [commands (<>.some <code>.any)]) - (in (list (` (|> (~! ..beginning) (~+ commands) ((~! ..end))))))) +(def: .public ||> + (syntax (_ [commands (<>.some <code>.any)]) + (in (list (` (|> (~! ..beginning) (~+ commands) ((~! ..end)))))))) (def: word (Parser [Code Text Code (List Code)]) @@ -124,21 +126,23 @@ <code>.any (<>.many <code>.any)))) -(syntax: .public (word: [[export_policy name type commands] ..word]) - (in (list (` (def: (~ export_policy) (~ (code.local name)) - (~ type) - (|>> (~+ commands))))))) - -(syntax: .public (apply [arity (<>.only (n.> 0) <code>.nat)]) - (with_symbols [g!_ g!func g!stack g!output] - (monad.do [! meta.monad] - [g!inputs (|> (macro.symbol "input") (list.repeated arity) (monad.all !))] - (in (list (` (is (All ((~ g!_) (~+ g!inputs) (~ g!output)) - (-> (-> (~+ g!inputs) (~ g!output)) - (=> [(~+ g!inputs)] [(~ g!output)]))) - (function ((~ g!_) (~ g!func)) - (function ((~ g!_) (~ (stack_mix g!inputs g!stack))) - [(~ g!stack) ((~ g!func) (~+ g!inputs))]))))))))) +(def: .public word: + (syntax (_ [[export_policy name type commands] ..word]) + (in (list (` (def: (~ export_policy) (~ (code.local name)) + (~ type) + (|>> (~+ commands)))))))) + +(def: .public apply + (syntax (_ [arity (<>.only (n.> 0) <code>.nat)]) + (with_symbols [g!_ g!func g!stack g!output] + (monad.do [! meta.monad] + [g!inputs (|> (macro.symbol "input") (list.repeated arity) (monad.all !))] + (in (list (` (is (All ((~ g!_) (~+ g!inputs) (~ g!output)) + (-> (-> (~+ g!inputs) (~ g!output)) + (=> [(~+ g!inputs)] [(~ g!output)]))) + (function ((~ g!_) (~ g!func)) + (function ((~ g!_) (~ (stack_mix g!inputs g!stack))) + [(~ g!stack) ((~ g!func) (~+ g!inputs))])))))))))) (template [<arity>] [(`` (def: .public (~~ (template.symbol ["apply_" <arity>])) diff --git a/stdlib/source/library/lux/control/concurrency/actor.lux b/stdlib/source/library/lux/control/concurrency/actor.lux index c4dd58b5e..b1eb1775d 100644 --- a/stdlib/source/library/lux/control/concurrency/actor.lux +++ b/stdlib/source/library/lux/control/concurrency/actor.lux @@ -21,7 +21,7 @@ ["[0]" list (.open: "[1]#[0]" monoid monad)]]] ["[0]" macro (.only with_symbols) ["[0]" code] - [syntax (.only syntax:) + [syntax (.only syntax) ["|[0]|" input] ["|[0]|" export]]] [math @@ -259,32 +259,34 @@ <code>.any behavior^))) -(syntax: .public (actor: [[export_policy [name vars] state_type [?on_mail messages]] ..actorP]) - (with_symbols [g!_] - (do meta.monad - [g!type (macro.symbol (format name "_primitive_type")) - .let [g!actor (code.local name) - g!vars (list#each code.local vars)]] - (in (list (` ((~! primitive:) (~ export_policy) ((~ g!type) (~+ g!vars)) - (~ state_type) - - (def: (~ export_policy) (~ g!actor) - (All ((~ g!_) (~+ g!vars)) - (..Behavior (~ state_type) ((~ g!type) (~+ g!vars)))) - [..#on_init (|>> ((~! primitive.abstraction) (~ g!type))) - ..#on_mail (~ (..on_mail g!_ ?on_mail))]) - - (~+ messages)))))))) - -(syntax: .public (actor [[state_type init] (<code>.tuple (<>.and <code>.any <code>.any)) - ?on_mail on_mail^]) - (with_symbols [g!_] - (in (list (` (is ((~! io.IO) (..Actor (~ state_type))) - (..spawn! (is (..Behavior (~ state_type) (~ state_type)) - [..#on_init (|>>) - ..#on_mail (~ (..on_mail g!_ ?on_mail))]) - (is (~ state_type) - (~ init))))))))) +(def: .public actor: + (syntax (_ [[export_policy [name vars] state_type [?on_mail messages]] ..actorP]) + (with_symbols [g!_] + (do meta.monad + [g!type (macro.symbol (format name "_primitive_type")) + .let [g!actor (code.local name) + g!vars (list#each code.local vars)]] + (in (list (` ((~! primitive:) (~ export_policy) ((~ g!type) (~+ g!vars)) + (~ state_type) + + (def: (~ export_policy) (~ g!actor) + (All ((~ g!_) (~+ g!vars)) + (..Behavior (~ state_type) ((~ g!type) (~+ g!vars)))) + [..#on_init (|>> ((~! primitive.abstraction) (~ g!type))) + ..#on_mail (~ (..on_mail g!_ ?on_mail))]) + + (~+ messages))))))))) + +(def: .public actor + (syntax (_ [[state_type init] (<code>.tuple (<>.and <code>.any <code>.any)) + ?on_mail on_mail^]) + (with_symbols [g!_] + (in (list (` (is ((~! io.IO) (..Actor (~ state_type))) + (..spawn! (is (..Behavior (~ state_type) (~ state_type)) + [..#on_init (|>>) + ..#on_mail (~ (..on_mail g!_ ?on_mail))]) + (is (~ state_type) + (~ init)))))))))) (type: Signature (Record @@ -316,32 +318,33 @@ <code>.any <code>.any))) -(syntax: .public (message: [[export_policy signature output_type body] ..messageP]) - (with_symbols [g!_ g!return] - (do meta.monad - [actor_scope primitive.current - .let [g!type (code.local (the primitive.#name actor_scope)) - g!message (code.local (the #name signature)) - g!actor_vars (the primitive.#type_vars actor_scope) - g!all_vars (|> signature (the #vars) (list#each code.local) (list#composite g!actor_vars)) - g!inputsC (|> signature (the #inputs) (list#each product.left)) - g!inputsT (|> signature (the #inputs) (list#each product.right)) - g!state (|> signature (the #state) code.local) - g!self (|> signature (the #self) code.local)]] - (in (list (` (def: (~ export_policy) ((~ g!message) (~+ g!inputsC)) - (All ((~ g!_) (~+ g!all_vars)) - (-> (~+ g!inputsT) - (..Message (~ (the primitive.#abstraction actor_scope)) - (~ output_type)))) - (function ((~ g!_) (~ g!state) (~ g!self)) - (let [(~ g!state) (as (~ (the primitive.#representation actor_scope)) - (~ g!state))] - (|> (~ body) - (is ((~! async.Async) ((~! try.Try) [(~ (the primitive.#representation actor_scope)) - (~ output_type)]))) - (as ((~! async.Async) ((~! try.Try) [(~ (the primitive.#abstraction actor_scope)) - (~ output_type)])))))))) - ))))) +(def: .public message: + (syntax (_ [[export_policy signature output_type body] ..messageP]) + (with_symbols [g!_ g!return] + (do meta.monad + [actor_scope primitive.current + .let [g!type (code.local (the primitive.#name actor_scope)) + g!message (code.local (the #name signature)) + g!actor_vars (the primitive.#type_vars actor_scope) + g!all_vars (|> signature (the #vars) (list#each code.local) (list#composite g!actor_vars)) + g!inputsC (|> signature (the #inputs) (list#each product.left)) + g!inputsT (|> signature (the #inputs) (list#each product.right)) + g!state (|> signature (the #state) code.local) + g!self (|> signature (the #self) code.local)]] + (in (list (` (def: (~ export_policy) ((~ g!message) (~+ g!inputsC)) + (All ((~ g!_) (~+ g!all_vars)) + (-> (~+ g!inputsT) + (..Message (~ (the primitive.#abstraction actor_scope)) + (~ output_type)))) + (function ((~ g!_) (~ g!state) (~ g!self)) + (let [(~ g!state) (as (~ (the primitive.#representation actor_scope)) + (~ g!state))] + (|> (~ body) + (is ((~! async.Async) ((~! try.Try) [(~ (the primitive.#representation actor_scope)) + (~ output_type)]))) + (as ((~! async.Async) ((~! try.Try) [(~ (the primitive.#abstraction actor_scope)) + (~ output_type)])))))))) + )))))) (type: .public Stop (IO Any)) diff --git a/stdlib/source/library/lux/control/continuation.lux b/stdlib/source/library/lux/control/continuation.lux index 3b22917af..69de59e57 100644 --- a/stdlib/source/library/lux/control/continuation.lux +++ b/stdlib/source/library/lux/control/continuation.lux @@ -10,7 +10,7 @@ [parser ["<[0]>" code]]] [macro (.only with_symbols) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]]]]) (type: .public (Cont i o) @@ -33,9 +33,10 @@ (f (function (_ a) (function (_ _) (k a))) k))) -(syntax: .public (pending [expr <code>.any]) - (with_symbols [g!_ g!k] - (in (list (` (.function ((~ g!_) (~ g!k)) ((~ g!k) (~ expr)))))))) +(def: .public pending + (syntax (_ [expr <code>.any]) + (with_symbols [g!_ g!k] + (in (list (` (.function ((~ g!_) (~ g!k)) ((~ g!k) (~ expr))))))))) (def: .public (reset scope) (All (_ i o) (-> (Cont i i) (Cont i o))) diff --git a/stdlib/source/library/lux/control/exception.lux b/stdlib/source/library/lux/control/exception.lux index 48276683c..81e46e66d 100644 --- a/stdlib/source/library/lux/control/exception.lux +++ b/stdlib/source/library/lux/control/exception.lux @@ -16,7 +16,7 @@ ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro ["[0]" code] - [syntax (.only syntax:) + [syntax (.only syntax) ["|[0]|" input] ["[0]" type ["|[1]_[0]|" variable]]]] @@ -90,21 +90,22 @@ (<>.and (<>#in (` .private)) private) ))) -(syntax: .public (exception: [[export_policy t_vars [name inputs] body] ..exception]) - (macro.with_symbols [g!_ g!descriptor] - (do meta.monad - [current_module meta.current_module_name - .let [descriptor (all text#composite "{" current_module "." name "}" text.new_line) - g!self (code.local name)]] - (in (list (` (def: (~ export_policy) - (~ g!self) - (All ((~ g!_) (~+ (list#each |type_variable|.format t_vars))) - (..Exception [(~+ (list#each (the |input|.#type) inputs))])) - (let [(~ g!descriptor) (~ (code.text descriptor))] - [..#label (~ g!descriptor) - ..#constructor (function ((~ g!self) [(~+ (list#each (the |input|.#binding) inputs))]) - ((~! text#composite) (~ g!descriptor) - (~ (maybe.else (' "") body))))])))))))) +(def: .public exception: + (syntax (_ [[export_policy t_vars [name inputs] body] ..exception]) + (macro.with_symbols [g!_ g!descriptor] + (do meta.monad + [current_module meta.current_module_name + .let [descriptor (all text#composite "{" current_module "." name "}" text.new_line) + g!self (code.local name)]] + (in (list (` (def: (~ export_policy) + (~ g!self) + (All ((~ g!_) (~+ (list#each |type_variable|.format t_vars))) + (..Exception [(~+ (list#each (the |input|.#type) inputs))])) + (let [(~ g!descriptor) (~ (code.text descriptor))] + [..#label (~ g!descriptor) + ..#constructor (function ((~ g!self) [(~+ (list#each (the |input|.#binding) inputs))]) + ((~! text#composite) (~ g!descriptor) + (~ (maybe.else (' "") body))))]))))))))) (def: (report' entries) (-> (List [Text Text]) Text) @@ -137,10 +138,11 @@ (on_entry head) tail)))) -(syntax: .public (report [entries (<>.many (<>.and <code>.any <code>.any))]) - (in (list (` ((~! ..report') (list (~+ (|> entries - (list#each (function (_ [header message]) - (` [(~ header) (~ message)]))))))))))) +(def: .public report + (syntax (_ [entries (<>.many (<>.and <code>.any <code>.any))]) + (in (list (` ((~! ..report') (list (~+ (|> entries + (list#each (function (_ [header message]) + (` [(~ header) (~ message)])))))))))))) (def: .public (listing format entries) (All (_ a) diff --git a/stdlib/source/library/lux/control/function/contract.lux b/stdlib/source/library/lux/control/function/contract.lux index d475de3e0..b5de83e82 100644 --- a/stdlib/source/library/lux/control/function/contract.lux +++ b/stdlib/source/library/lux/control/function/contract.lux @@ -9,7 +9,7 @@ [text ["%" format (.only format)]]] [macro (.only with_symbols) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math [number @@ -30,18 +30,20 @@ [] (panic! message))) -(syntax: .public (pre [test <code>.any - expr <code>.any]) - (in (list (` (exec - ((~! ..assert!) (~ (code.text (exception.error ..pre_condition_failed test))) - (~ test)) - (~ expr)))))) +(def: .public pre + (syntax (_ [test <code>.any + expr <code>.any]) + (in (list (` (exec + ((~! ..assert!) (~ (code.text (exception.error ..pre_condition_failed test))) + (~ test)) + (~ expr))))))) -(syntax: .public (post [test <code>.any - expr <code>.any]) - (with_symbols [g!output] - (in (list (` (let [(~ g!output) (~ expr)] - (exec - ((~! ..assert!) (~ (code.text (exception.error ..post_condition_failed test))) - ((~ test) (~ g!output))) - (~ g!output)))))))) +(def: .public post + (syntax (_ [test <code>.any + expr <code>.any]) + (with_symbols [g!output] + (in (list (` (let [(~ g!output) (~ expr)] + (exec + ((~! ..assert!) (~ (code.text (exception.error ..post_condition_failed test))) + ((~ test) (~ g!output))) + (~ g!output))))))))) diff --git a/stdlib/source/library/lux/control/function/inline.lux b/stdlib/source/library/lux/control/function/inline.lux index d65fd1f41..e171f1f87 100644 --- a/stdlib/source/library/lux/control/function/inline.lux +++ b/stdlib/source/library/lux/control/function/inline.lux @@ -12,7 +12,7 @@ ["[0]" list (.open: "[1]#[0]" monad)]]] ["[0]" macro (.only) ["[0]" code] - [syntax (.only syntax:) + [syntax (.only syntax) ["|[0]|" export]]]]]) (def: declaration @@ -28,23 +28,25 @@ <code>.any ))) -(syntax: .public (inline: [[privacy [name parameters] type term] ..inline]) - (do [! meta.monad] - [@ meta.current_module_name - g!parameters (|> (macro.symbol "parameter") - (list.repeated (list.size parameters)) - (monad.all !)) - .let [inlined (` (("lux in-module" - (~ (code.text @)) - (.is (~ type) - (.function ((~ (code.local name)) (~+ parameters)) - (~ term)))) - (~+ (list#each (function (_ g!parameter) - (` ((~' ~) (~ g!parameter)))) - g!parameters)))) - g!parameters (|> g!parameters - (list#each (function (_ parameter) - (list parameter (` (~! <code>.any))))) - list#conjoint)]] - (in (list (` ((~! syntax:) (~ privacy) ((~ (code.local name)) [(~+ g!parameters)]) - (.at (~! meta.monad) (~' in) (.list (.`' (~ inlined)))))))))) +(def: .public inline: + (syntax (_ [[privacy [name parameters] type term] ..inline]) + (do [! meta.monad] + [@ meta.current_module_name + g!parameters (|> (macro.symbol "parameter") + (list.repeated (list.size parameters)) + (monad.all !)) + .let [inlined (` (("lux in-module" + (~ (code.text @)) + (.is (~ type) + (.function ((~ (code.local name)) (~+ parameters)) + (~ term)))) + (~+ (list#each (function (_ g!parameter) + (` ((~' ~) (~ g!parameter)))) + g!parameters)))) + g!parameters (|> g!parameters + (list#each (function (_ parameter) + (list parameter (` (~! <code>.any))))) + list#conjoint)]] + (in (list (` (def: (~ privacy) (~ (code.local name)) + ((~! syntax) ((~ (code.local name)) [(~+ g!parameters)]) + (.at (~! meta.monad) (~' in) (.list (.`' (~ inlined)))))))))))) diff --git a/stdlib/source/library/lux/control/function/mutual.lux b/stdlib/source/library/lux/control/function/mutual.lux index 6f6ff6280..47f48a15a 100644 --- a/stdlib/source/library/lux/control/function/mutual.lux +++ b/stdlib/source/library/lux/control/function/mutual.lux @@ -20,7 +20,7 @@ ["[0]" macro (.only) ["[0]" local] ["[0]" code] - [syntax (.only syntax:) + [syntax (.only syntax) ["[0]" declaration (.only Declaration)]]]]] ["[0]" //]) @@ -52,48 +52,49 @@ (function (_ parameters) (at meta.monad in (list (` (((~ g!self) (~ g!context)) (~+ parameters)))))))) -(syntax: .public (let [functions (<code>.tuple (<>.some ..mutual)) - body <code>.any]) - (case functions - {.#End} - (in (list body)) - - {.#Item mutual {.#End}} - (.let [g!name (|> mutual (the [#declaration declaration.#name]) code.local)] - (in (list (` (.let [(~ g!name) (is (~ (the #type mutual)) - (function (~ (declaration.format (the #declaration mutual))) - (~ (the #body mutual))))] - (~ body)))))) - - _ - (macro.with_symbols [g!context g!output] - (do [! meta.monad] - [here_name meta.current_module_name - hidden_names (monad.each ! (//.constant (macro.symbol "mutual_function#")) - functions) - .let [definitions (list#each (..mutual_definition hidden_names g!context) - (list.zipped_2 hidden_names - functions)) - context_types (list#each (function (_ mutual) - (` (-> (~ g!context) (~ (the #type mutual))))) - functions) - user_names (list#each (|>> (the [#declaration declaration.#name]) code.local) - functions)] - g!pop (local.push (list#each (function (_ [g!name mutual]) - [[here_name (the [#declaration declaration.#name] mutual)] - (..macro g!context g!name)]) - (list.zipped_2 hidden_names - functions)))] - (in (list (` (.let [(~ g!context) (is (Rec (~ g!context) - [(~+ context_types)]) - [(~+ definitions)]) - [(~+ user_names)] (.let [[(~+ user_names)] (~ g!context)] - [(~+ (list#each (function (_ g!name) - (` ((~ g!name) (~ g!context)))) - user_names))]) - (~ g!output) (~ body)] - (exec (~ g!pop) - (~ g!output)))))))))) +(.def: .public let + (syntax (_ [functions (<code>.tuple (<>.some ..mutual)) + body <code>.any]) + (case functions + {.#End} + (in (list body)) + + {.#Item mutual {.#End}} + (.let [g!name (|> mutual (the [#declaration declaration.#name]) code.local)] + (in (list (` (.let [(~ g!name) (is (~ (the #type mutual)) + (function (~ (declaration.format (the #declaration mutual))) + (~ (the #body mutual))))] + (~ body)))))) + + _ + (macro.with_symbols [g!context g!output] + (do [! meta.monad] + [here_name meta.current_module_name + hidden_names (monad.each ! (//.constant (macro.symbol "mutual_function#")) + functions) + .let [definitions (list#each (..mutual_definition hidden_names g!context) + (list.zipped_2 hidden_names + functions)) + context_types (list#each (function (_ mutual) + (` (-> (~ g!context) (~ (the #type mutual))))) + functions) + user_names (list#each (|>> (the [#declaration declaration.#name]) code.local) + functions)] + g!pop (local.push (list#each (function (_ [g!name mutual]) + [[here_name (the [#declaration declaration.#name] mutual)] + (..macro g!context g!name)]) + (list.zipped_2 hidden_names + functions)))] + (in (list (` (.let [(~ g!context) (is (Rec (~ g!context) + [(~+ context_types)]) + [(~+ definitions)]) + [(~+ user_names)] (.let [[(~+ user_names)] (~ g!context)] + [(~+ (list#each (function (_ g!name) + (` ((~ g!name) (~ g!context)))) + user_names))]) + (~ g!output) (~ body)] + (exec (~ g!pop) + (~ g!output))))))))))) (type: Definition (Record @@ -105,53 +106,54 @@ (<code>.tuple (<>.either (<>.and <code>.any ..mutual) (<>.and (<>#in (` .private)) ..mutual)))) -(syntax: .public (def: [functions (<>.many ..definition)]) - (case functions - {.#End} - (in (list)) - - {.#Item definition {.#End}} - (.let [(open "_[0]") definition - (open "_[0]") _#mutual] - (in (list (` (.def: (~ _#export_policy) (~ (declaration.format _#declaration)) - (~ _#type) - (~ _#body)))))) - - _ - (macro.with_symbols [g!context g!output] - (do [! meta.monad] - [here_name meta.current_module_name - hidden_names (monad.each ! (//.constant (macro.symbol "mutual_function#")) - functions) - .let [definitions (list#each (..mutual_definition hidden_names g!context) - (list.zipped_2 hidden_names - (list#each (the #mutual) functions))) - context_types (list#each (function (_ mutual) - (` (-> (~ g!context) (~ (the [#mutual #type] mutual))))) - functions) - user_names (list#each (|>> (the [#mutual #declaration declaration.#name]) code.local) - functions)] - g!pop (local.push (list#each (function (_ [g!name mutual]) - [[here_name (the [#mutual #declaration declaration.#name] mutual)] - (..macro g!context g!name)]) - (list.zipped_2 hidden_names - functions)))] - (in (partial_list (` (.def: (~ g!context) - [(~+ (list#each (the [#mutual #type]) functions))] - (.let [(~ g!context) (is (Rec (~ g!context) - [(~+ context_types)]) - [(~+ definitions)]) - [(~+ user_names)] (~ g!context)] - [(~+ (list#each (function (_ g!name) - (` ((~ g!name) (~ g!context)))) - user_names))]))) - g!pop - (list#each (function (_ mutual) - (.let [g!name (|> mutual (the [#mutual #declaration declaration.#name]) code.local)] - (` (.def: - (~ (the #export_policy mutual)) - (~ g!name) - (~ (the [#mutual #type] mutual)) - (.let [[(~+ user_names)] (~ g!context)] - (~ g!name)))))) - functions))))))) +(.def: .public def: + (syntax (_ [functions (<>.many ..definition)]) + (case functions + {.#End} + (in (list)) + + {.#Item definition {.#End}} + (.let [(open "_[0]") definition + (open "_[0]") _#mutual] + (in (list (` (.def: (~ _#export_policy) (~ (declaration.format _#declaration)) + (~ _#type) + (~ _#body)))))) + + _ + (macro.with_symbols [g!context g!output] + (do [! meta.monad] + [here_name meta.current_module_name + hidden_names (monad.each ! (//.constant (macro.symbol "mutual_function#")) + functions) + .let [definitions (list#each (..mutual_definition hidden_names g!context) + (list.zipped_2 hidden_names + (list#each (the #mutual) functions))) + context_types (list#each (function (_ mutual) + (` (-> (~ g!context) (~ (the [#mutual #type] mutual))))) + functions) + user_names (list#each (|>> (the [#mutual #declaration declaration.#name]) code.local) + functions)] + g!pop (local.push (list#each (function (_ [g!name mutual]) + [[here_name (the [#mutual #declaration declaration.#name] mutual)] + (..macro g!context g!name)]) + (list.zipped_2 hidden_names + functions)))] + (in (partial_list (` (.def: (~ g!context) + [(~+ (list#each (the [#mutual #type]) functions))] + (.let [(~ g!context) (is (Rec (~ g!context) + [(~+ context_types)]) + [(~+ definitions)]) + [(~+ user_names)] (~ g!context)] + [(~+ (list#each (function (_ g!name) + (` ((~ g!name) (~ g!context)))) + user_names))]))) + g!pop + (list#each (function (_ mutual) + (.let [g!name (|> mutual (the [#mutual #declaration declaration.#name]) code.local)] + (` (.def: + (~ (the #export_policy mutual)) + (~ g!name) + (~ (the [#mutual #type] mutual)) + (.let [[(~+ user_names)] (~ g!context)] + (~ g!name)))))) + functions)))))))) diff --git a/stdlib/source/library/lux/control/io.lux b/stdlib/source/library/lux/control/io.lux index ac513fc05..ef5e9eecf 100644 --- a/stdlib/source/library/lux/control/io.lux +++ b/stdlib/source/library/lux/control/io.lux @@ -11,7 +11,7 @@ [type [primitive (.except)]] [macro (.only with_symbols) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" template]]]]) (primitive: .public (IO a) @@ -31,10 +31,11 @@ ... creatio ex nihilo [((representation io) [])]) - (syntax: .public (io [computation <code>.any]) - (with_symbols [g!func g!arg] - (in (list (` ((~! ..label) (function ((~ g!func) (~ g!arg)) - (~ computation)))))))) + (def: .public io + (syntax (_ [computation <code>.any]) + (with_symbols [g!func g!arg] + (in (list (` ((~! ..label) (function ((~ g!func) (~ g!arg)) + (~ computation))))))))) (def: .public run! (All (_ a) (-> (IO a) a)) diff --git a/stdlib/source/library/lux/control/lazy.lux b/stdlib/source/library/lux/control/lazy.lux index fc97cd06f..afa816e00 100644 --- a/stdlib/source/library/lux/control/lazy.lux +++ b/stdlib/source/library/lux/control/lazy.lux @@ -13,7 +13,7 @@ [concurrency ["[0]" atom]]] [macro (.only with_symbols) - [syntax (.only syntax:)]] + [syntax (.only syntax)]] [type (.only sharing) [primitive (.except)]]]]) @@ -43,9 +43,10 @@ (All (_ a) (-> (Lazy a) a)) ((representation lazy) []))) -(syntax: .public (lazy [expression <code>.any]) - (with_symbols [g!_] - (in (list (` ((~! ..lazy') (function ((~ g!_) (~ g!_)) (~ expression)))))))) +(def: .public lazy + (syntax (_ [expression <code>.any]) + (with_symbols [g!_] + (in (list (` ((~! ..lazy') (function ((~ g!_) (~ g!_)) (~ expression))))))))) (implementation: .public (equivalence (open "_#[0]")) (All (_ a) (-> (Equivalence a) (Equivalence (Lazy a)))) diff --git a/stdlib/source/library/lux/control/pipe.lux b/stdlib/source/library/lux/control/pipe.lux index 4f5e3298c..d935a3c6f 100644 --- a/stdlib/source/library/lux/control/pipe.lux +++ b/stdlib/source/library/lux/control/pipe.lux @@ -12,7 +12,7 @@ [collection ["[0]" list (.open: "[1]#[0]" monad)]]] [macro (.only with_symbols) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math [number @@ -23,93 +23,103 @@ (Parser (List Code)) (<code>.tuple (<>.some <code>.any))) -(syntax: .public (new [start <code>.any - body ..body - prev <code>.any]) - (in (list (` (|> (~ start) (~+ body)))))) +(def: .public new + (syntax (_ [start <code>.any + body ..body + prev <code>.any]) + (in (list (` (|> (~ start) (~+ body))))))) -(syntax: .public (let [binding <code>.any - body <code>.any - prev <code>.any]) - (in (list (` (.let [(~ binding) (~ prev)] - (~ body)))))) +(def: .public let + (syntax (_ [binding <code>.any + body <code>.any + prev <code>.any]) + (in (list (` (.let [(~ binding) (~ prev)] + (~ body))))))) (def: _reversed_ (Parser Any) (function (_ tokens) {try.#Success [(list.reversed tokens) []]})) -(syntax: .public (cond [_ _reversed_ - prev <code>.any - else ..body - _ _reversed_ - branches (<>.some (<>.and ..body ..body))]) - (with_symbols [g!temp] - (in (list (` (.let [(~ g!temp) (~ prev)] - (.cond (~+ (monad.do list.monad - [[test then] branches] - (list (` (|> (~ g!temp) (~+ test))) - (` (|> (~ g!temp) (~+ then)))))) - (|> (~ g!temp) (~+ else))))))))) +(def: .public cond + (syntax (_ [_ _reversed_ + prev <code>.any + else ..body + _ _reversed_ + branches (<>.some (<>.and ..body ..body))]) + (with_symbols [g!temp] + (in (list (` (.let [(~ g!temp) (~ prev)] + (.cond (~+ (monad.do list.monad + [[test then] branches] + (list (` (|> (~ g!temp) (~+ test))) + (` (|> (~ g!temp) (~+ then)))))) + (|> (~ g!temp) (~+ else)))))))))) -(syntax: .public (if [test ..body - then ..body - else ..body - prev <code>.any]) - (in (list (` (..cond [(~+ test)] [(~+ then)] - [(~+ else)] - (~ prev)))))) +(def: .public if + (syntax (_ [test ..body + then ..body + else ..body + prev <code>.any]) + (in (list (` (..cond [(~+ test)] [(~+ then)] + [(~+ else)] + (~ prev))))))) -(syntax: .public (when [test ..body - then ..body - prev <code>.any]) - (in (list (` (..cond [(~+ test)] [(~+ then)] - [] - (~ prev)))))) +(def: .public when + (syntax (_ [test ..body + then ..body + prev <code>.any]) + (in (list (` (..cond [(~+ test)] [(~+ then)] + [] + (~ prev))))))) -(syntax: .public (while [test ..body - then ..body - prev <code>.any]) - (with_symbols [g!temp g!again] - (in (list (` (.loop ((~ g!again) [(~ g!temp) (~ prev)]) - (.if (|> (~ g!temp) (~+ test)) - ((~ g!again) (|> (~ g!temp) (~+ then))) - (~ g!temp)))))))) +(def: .public while + (syntax (_ [test ..body + then ..body + prev <code>.any]) + (with_symbols [g!temp g!again] + (in (list (` (.loop ((~ g!again) [(~ g!temp) (~ prev)]) + (.if (|> (~ g!temp) (~+ test)) + ((~ g!again) (|> (~ g!temp) (~+ then))) + (~ g!temp))))))))) -(syntax: .public (do [monad <code>.any - steps (<>.some ..body) - prev <code>.any]) - (with_symbols [g!temp] - (.case (list.reversed steps) - (pattern (partial_list last_step prev_steps)) - (.let [step_bindings (monad.do list.monad - [step (list.reversed prev_steps)] - (list g!temp (` (|> (~ g!temp) (~+ step)))))] - (in (list (` ((~! monad.do) (~ monad) - [.let [(~ g!temp) (~ prev)] - (~+ step_bindings)] - (|> (~ g!temp) (~+ last_step))))))) +(def: .public do + (syntax (_ [monad <code>.any + steps (<>.some ..body) + prev <code>.any]) + (with_symbols [g!temp] + (.case (list.reversed steps) + (pattern (partial_list last_step prev_steps)) + (.let [step_bindings (monad.do list.monad + [step (list.reversed prev_steps)] + (list g!temp (` (|> (~ g!temp) (~+ step)))))] + (in (list (` ((~! monad.do) (~ monad) + [.let [(~ g!temp) (~ prev)] + (~+ step_bindings)] + (|> (~ g!temp) (~+ last_step))))))) - _ - (in (list prev))))) + _ + (in (list prev)))))) -(syntax: .public (exec [body ..body - prev <code>.any]) - (with_symbols [g!temp] - (in (list (` (.let [(~ g!temp) (~ prev)] - (.exec (|> (~ g!temp) (~+ body)) - (~ g!temp)))))))) +(def: .public exec + (syntax (_ [body ..body + prev <code>.any]) + (with_symbols [g!temp] + (in (list (` (.let [(~ g!temp) (~ prev)] + (.exec (|> (~ g!temp) (~+ body)) + (~ g!temp))))))))) -(syntax: .public (tuple [paths (<>.many ..body) - prev <code>.any]) - (with_symbols [g!temp] - (in (list (` (.let [(~ g!temp) (~ prev)] - [(~+ (list#each (function (_ body) (` (|> (~ g!temp) (~+ body)))) - paths))])))))) +(def: .public tuple + (syntax (_ [paths (<>.many ..body) + prev <code>.any]) + (with_symbols [g!temp] + (in (list (` (.let [(~ g!temp) (~ prev)] + [(~+ (list#each (function (_ body) (` (|> (~ g!temp) (~+ body)))) + paths))]))))))) -(syntax: .public (case [branches (<>.many (<>.and <code>.any <code>.any)) - prev <code>.any]) - (in (list (` (.case (~ prev) - (~+ (|> branches - (list#each (function (_ [pattern body]) (list pattern body))) - list#conjoint))))))) +(def: .public case + (syntax (_ [branches (<>.many (<>.and <code>.any <code>.any)) + prev <code>.any]) + (in (list (` (.case (~ prev) + (~+ (|> branches + (list#each (function (_ [pattern body]) (list pattern body))) + list#conjoint)))))))) diff --git a/stdlib/source/library/lux/control/remember.lux b/stdlib/source/library/lux/control/remember.lux index 02e6c5011..dd72e4d7a 100644 --- a/stdlib/source/library/lux/control/remember.lux +++ b/stdlib/source/library/lux/control/remember.lux @@ -19,7 +19,7 @@ [macro ["[0]" code] ["[0]" template] - [syntax (.only syntax:)]]]]) + [syntax (.only syntax)]]]]) (exception: .public (must_remember [deadline Date today Date @@ -50,32 +50,34 @@ {try.#Failure message} (<>.failure message))))) -(syntax: .public (remember [deadline ..deadline - message <c>.text - focus (<>.maybe <c>.any)]) - (let [now (io.run! instant.now) - today (instant.date now)] - (if (date#< deadline today) - (in (case focus - {.#Some focus} - (list focus) +(def: .public remember + (syntax (_ [deadline ..deadline + message <c>.text + focus (<>.maybe <c>.any)]) + (let [now (io.run! instant.now) + today (instant.date now)] + (if (date#< deadline today) + (in (case focus + {.#Some focus} + (list focus) - {.#None} - (list))) - (meta.failure (exception.error ..must_remember [deadline today message focus]))))) + {.#None} + (list))) + (meta.failure (exception.error ..must_remember [deadline today message focus])))))) (template [<name> <message>] - [(`` (syntax: .public (<name> [deadline ..deadline - message <c>.text - focus (<>.maybe <c>.any)]) - (in (list (` (..remember (~ (code.text (%.date deadline))) - (~ (code.text (format <message> " " message))) - (~+ (case focus - {.#Some focus} - (list focus) + [(`` (def: .public <name> + (syntax (_ [deadline ..deadline + message <c>.text + focus (<>.maybe <c>.any)]) + (in (list (` (..remember (~ (code.text (%.date deadline))) + (~ (code.text (format <message> " " message))) + (~+ (case focus + {.#Some focus} + (list focus) - {.#None} - (list)))))))))] + {.#None} + (list))))))))))] [to_do "TODO"] [fix_me "FIXME"] diff --git a/stdlib/source/library/lux/control/security/capability.lux b/stdlib/source/library/lux/control/security/capability.lux index 84a605e26..c7e23dfb3 100644 --- a/stdlib/source/library/lux/control/security/capability.lux +++ b/stdlib/source/library/lux/control/security/capability.lux @@ -19,7 +19,7 @@ ["[0]" meta] ["[0]" macro (.only) ["[0]" code] - [syntax (.only syntax:) + [syntax (.only syntax) ["|[0]|" export] ["|[0]|" declaration]]]]]) @@ -39,27 +39,28 @@ output)) ((representation capability) input)) - (syntax: .public (capability: [[export_policy declaration [forger input output]] - (|export|.parser - (all <>.and - |declaration|.parser - (<c>.form (all <>.and <c>.local <c>.any <c>.any))))]) - (macro.with_symbols [g!_] - (do [! meta.monad] - [this_module meta.current_module_name - .let [[name vars] declaration] - g!brand (at ! each (|>> %.code code.text) - (macro.symbol (format (%.symbol [this_module name])))) - .let [capability (` (..Capability (.Primitive (~ g!brand)) (~ input) (~ output)))]] - (in (list (` (type: (~ export_policy) - (~ (|declaration|.format declaration)) - (~ capability))) - (` (def: (~ (code.local forger)) - (All ((~ g!_) (~+ (list#each code.local vars))) - (-> (-> (~ input) (~ output)) - (~ capability))) - (~! ..capability))) - ))))) + (def: .public capability: + (syntax (_ [[export_policy declaration [forger input output]] + (|export|.parser + (all <>.and + |declaration|.parser + (<c>.form (all <>.and <c>.local <c>.any <c>.any))))]) + (macro.with_symbols [g!_] + (do [! meta.monad] + [this_module meta.current_module_name + .let [[name vars] declaration] + g!brand (at ! each (|>> %.code code.text) + (macro.symbol (format (%.symbol [this_module name])))) + .let [capability (` (..Capability (.Primitive (~ g!brand)) (~ input) (~ output)))]] + (in (list (` (type: (~ export_policy) + (~ (|declaration|.format declaration)) + (~ capability))) + (` (def: (~ (code.local forger)) + (All ((~ g!_) (~+ (list#each code.local vars))) + (-> (-> (~ input) (~ output)) + (~ capability))) + (~! ..capability))) + )))))) (def: .public (async capability) (All (_ brand input output) diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux index 74654008c..39bce01ad 100644 --- a/stdlib/source/library/lux/data/collection/sequence.lux +++ b/stdlib/source/library/lux/data/collection/sequence.lux @@ -26,7 +26,7 @@ ["[0]" array ["[1]" \\unsafe (.only Array)]]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["^" pattern] ["[0]" code]] [math @@ -365,8 +365,9 @@ (All (_ a) (-> (Sequence a) Bit)) (|>> (the #size) (n.= 0))) -(syntax: .public (sequence [elems (<>.some <code>.any)]) - (in (.list (` (..of_list (.list (~+ elems))))))) +(def: .public sequence + (syntax (_ [elems (<>.some <code>.any)]) + (in (.list (` (..of_list (.list (~+ elems)))))))) (implementation: (node_equivalence //#=) (All (_ a) (-> (Equivalence a) (Equivalence (Node a)))) diff --git a/stdlib/source/library/lux/data/collection/stream.lux b/stdlib/source/library/lux/data/collection/stream.lux index ac6a8c50e..0c8ba2d85 100644 --- a/stdlib/source/library/lux/data/collection/stream.lux +++ b/stdlib/source/library/lux/data/collection/stream.lux @@ -13,7 +13,7 @@ [collection ["[0]" list (.open: "[1]#[0]" monad)]]] [macro (.only with_symbols) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math [number @@ -127,14 +127,15 @@ (let [[head tail] (//.result wa)] (//.pending [wa (disjoint tail)])))) -(syntax: .public (pattern [patterns (<code>.form (<>.many <code>.any)) - body <code>.any - branches (<>.some <code>.any)]) - (with_symbols [g!stream] - (let [body+ (` (let [(~+ (|> patterns - (list#each (function (_ pattern) - (list (` [(~ pattern) (~ g!stream)]) - (` ((~! //.result) (~ g!stream)))))) - list#conjoint))] - (~ body)))] - (in (partial_list g!stream body+ branches))))) +(def: .public pattern + (syntax (_ [patterns (<code>.form (<>.many <code>.any)) + body <code>.any + branches (<>.some <code>.any)]) + (with_symbols [g!stream] + (let [body+ (` (let [(~+ (|> patterns + (list#each (function (_ pattern) + (list (` [(~ pattern) (~ g!stream)]) + (` ((~! //.result) (~ g!stream)))))) + list#conjoint))] + (~ body)))] + (in (partial_list g!stream body+ branches)))))) diff --git a/stdlib/source/library/lux/data/collection/tree.lux b/stdlib/source/library/lux/data/collection/tree.lux index 43f2f16c9..52f7f4ec4 100644 --- a/stdlib/source/library/lux/data/collection/tree.lux +++ b/stdlib/source/library/lux/data/collection/tree.lux @@ -13,7 +13,7 @@ [collection ["[0]" list (.open: "[1]#[0]" monad mix)]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]]]]) (type: .public (Tree a) @@ -54,10 +54,11 @@ (<>.else (list)) (<>.and <code>.any))) -(syntax: .public (tree [root tree^]) - (in (list (loop (again [[value children] root]) - (` [#value (~ value) - #children (list (~+ (list#each again children)))]))))) +(def: .public tree + (syntax (_ [root tree^]) + (in (list (loop (again [[value children] root]) + (` [#value (~ value) + #children (list (~+ (list#each again children)))])))))) (implementation: .public (equivalence super) (All (_ a) (-> (Equivalence a) (Equivalence (Tree a)))) diff --git a/stdlib/source/library/lux/data/format/css/class.lux b/stdlib/source/library/lux/data/format/css/class.lux index 6a9ab5e90..c5a3f1e53 100644 --- a/stdlib/source/library/lux/data/format/css/class.lux +++ b/stdlib/source/library/lux/data/format/css/class.lux @@ -8,7 +8,7 @@ ["[0]" text (.open: "[1]#[0]" hash) ["%" format (.only format)]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [type [primitive (.except)]]]]) @@ -24,10 +24,11 @@ (-> Text Class) (|>> abstraction)) - (syntax: .public (generic []) - (do meta.monad - [module meta.current_module_name - class meta.seed] - (in (list (` (..custom (~ (code.text (format "c" (%.nat_16 class) - "_" (%.nat_16 (text#hash module))))))))))) + (def: .public generic + (syntax (_ []) + (do meta.monad + [module meta.current_module_name + class meta.seed] + (in (list (` (..custom (~ (code.text (format "c" (%.nat_16 class) + "_" (%.nat_16 (text#hash module)))))))))))) ) diff --git a/stdlib/source/library/lux/data/format/css/font.lux b/stdlib/source/library/lux/data/format/css/font.lux index d0a879509..3c06ac129 100644 --- a/stdlib/source/library/lux/data/format/css/font.lux +++ b/stdlib/source/library/lux/data/format/css/font.lux @@ -6,8 +6,6 @@ [control [parser ["s" code]]] - ["[0]" macro - [syntax (.only syntax:)]] [world [net (.only URL)]]]] ["[0]" // diff --git a/stdlib/source/library/lux/data/format/css/id.lux b/stdlib/source/library/lux/data/format/css/id.lux index 5de67ed56..be23c0f17 100644 --- a/stdlib/source/library/lux/data/format/css/id.lux +++ b/stdlib/source/library/lux/data/format/css/id.lux @@ -8,7 +8,7 @@ ["[0]" text (.open: "[1]#[0]" hash) ["%" format (.only format)]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [type [primitive (.except)]]]]) @@ -24,10 +24,11 @@ (-> Text ID) (|>> abstraction)) - (syntax: .public (generic []) - (do meta.monad - [module meta.current_module_name - id meta.seed] - (in (list (` (..custom (~ (code.text (format "i" (%.nat_16 id) - "_" (%.nat_16 (text#hash module))))))))))) + (def: .public generic + (syntax (_ []) + (do meta.monad + [module meta.current_module_name + id meta.seed] + (in (list (` (..custom (~ (code.text (format "i" (%.nat_16 id) + "_" (%.nat_16 (text#hash module)))))))))))) ) diff --git a/stdlib/source/library/lux/data/format/css/property.lux b/stdlib/source/library/lux/data/format/css/property.lux index b8153afe7..3ee23b2b7 100644 --- a/stdlib/source/library/lux/data/format/css/property.lux +++ b/stdlib/source/library/lux/data/format/css/property.lux @@ -11,7 +11,7 @@ [macro ["[0]" template] ["[0]" code] - [syntax (.only syntax:)]]]] + [syntax (.only syntax)]]]] [// [value (.only All Number @@ -54,8 +54,9 @@ White_Space Word_Break Word_Wrap Writing_Mode Z_Index)]]) -(syntax: (text_symbol [symbol s.text]) - (in (list (code.local (text.replaced "-" "_" symbol))))) +(def: text_symbol + (syntax (_ [symbol s.text]) + (in (list (code.local (text.replaced "-" "_" symbol)))))) (primitive: .public (Property brand) Text diff --git a/stdlib/source/library/lux/data/format/css/query.lux b/stdlib/source/library/lux/data/format/css/query.lux index de81ee371..7bd1c2c5d 100644 --- a/stdlib/source/library/lux/data/format/css/query.lux +++ b/stdlib/source/library/lux/data/format/css/query.lux @@ -10,7 +10,7 @@ [macro ["[0]" template] ["[0]" code] - [syntax (.only syntax:)]] + [syntax (.only syntax)]] [type [primitive (.except)]]]] ["[0]" // @@ -21,8 +21,9 @@ Pointer Hover Light Scripting Motion Color_Scheme)]]) -(syntax: (text_symbol [symbol s.text]) - (in (list (code.local (text.replaced "-" "_" symbol))))) +(def: text_symbol + (syntax (_ [symbol s.text]) + (in (list (code.local (text.replaced "-" "_" symbol)))))) (primitive: .public Media Text diff --git a/stdlib/source/library/lux/data/format/css/value.lux b/stdlib/source/library/lux/data/format/css/value.lux index 633ffde55..743cd781b 100644 --- a/stdlib/source/library/lux/data/format/css/value.lux +++ b/stdlib/source/library/lux/data/format/css/value.lux @@ -13,7 +13,7 @@ [collection ["[0]" list (.open: "[1]#[0]" functor)]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" template] ["[0]" code]] [math @@ -29,8 +29,9 @@ [// [selector (.only Label)]]) -(syntax: (text_symbol [symbol <code>.text]) - (in (list (code.local (text.replaced "-" "_" symbol))))) +(def: text_symbol + (syntax (_ [symbol <code>.text]) + (in (list (code.local (text.replaced "-" "_" symbol)))))) (template: (enumeration: <abstraction> <representation> <out> <sample>+ <definition>+) [(primitive: .public <abstraction> diff --git a/stdlib/source/library/lux/data/format/json.lux b/stdlib/source/library/lux/data/format/json.lux index 54ef372f1..6e358ec80 100644 --- a/stdlib/source/library/lux/data/format/json.lux +++ b/stdlib/source/library/lux/data/format/json.lux @@ -23,7 +23,7 @@ ["[0]" sequence (.only Sequence sequence) (.open: "[1]#[0]" monad)] ["[0]" dictionary (.only Dictionary)]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["^" pattern] ["[0]" code]] [math @@ -122,8 +122,9 @@ {#Code' code} code)) -(syntax: .public (json [token ..jsonP]) - (in (list (` (is JSON (~ (jsonF token))))))) +(def: .public json + (syntax (_ [token ..jsonP]) + (in (list (` (is JSON (~ (jsonF token)))))))) (def: .public (fields json) (-> JSON (Try (List String))) diff --git a/stdlib/source/library/lux/data/text/escape.lux b/stdlib/source/library/lux/data/text/escape.lux index c1dc7a17f..7b9caa349 100644 --- a/stdlib/source/library/lux/data/text/escape.lux +++ b/stdlib/source/library/lux/data/text/escape.lux @@ -14,7 +14,7 @@ [number (.only hex) ["n" nat]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["^" pattern] ["[0]" code]]]] ["[0]" // (.only Char) @@ -239,10 +239,11 @@ "" current _ (format previous current))}))) -(syntax: .public (literal [literal <code>.text]) - (case (..un_escaped literal) - {try.#Success un_escaped} - (in (list (code.text un_escaped))) - - {try.#Failure error} - (meta.failure error))) +(def: .public literal + (syntax (_ [literal <code>.text]) + (case (..un_escaped literal) + {try.#Success un_escaped} + (in (list (code.text un_escaped))) + + {try.#Failure error} + (meta.failure error)))) diff --git a/stdlib/source/library/lux/data/text/format.lux b/stdlib/source/library/lux/data/text/format.lux index 2da8de70b..7c5483112 100644 --- a/stdlib/source/library/lux/data/text/format.lux +++ b/stdlib/source/library/lux/data/text/format.lux @@ -31,7 +31,7 @@ ["[0]" frac] ["[0]" ratio]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code] ["[0]" template]] [meta @@ -48,8 +48,9 @@ (def: (each f fb) (|>> f fb))) -(syntax: .public (format [fragments (<>.many <code>.any)]) - (in (.list (` (all "lux text concat" (~+ fragments)))))) +(def: .public format + (syntax (_ [fragments (<>.many <code>.any)]) + (in (.list (` (all "lux text concat" (~+ fragments))))))) (template [<name> <type> <formatter>] [(def: .public <name> diff --git a/stdlib/source/library/lux/data/text/regex.lux b/stdlib/source/library/lux/data/text/regex.lux index 010dbd815..8e48c00d4 100644 --- a/stdlib/source/library/lux/data/text/regex.lux +++ b/stdlib/source/library/lux/data/text/regex.lux @@ -16,7 +16,7 @@ [collection ["[0]" list (.open: "[1]#[0]" mix monad)]]] [macro (.only with_symbols) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["^" pattern] ["[0]" code]] [math @@ -414,24 +414,26 @@ (-> Text (Parser Code)) (at <>.monad each product.right (re_alternative^ #1 re_scoped^ current_module))) -(syntax: .public (regex [pattern <code>.text]) - (do meta.monad - [current_module meta.current_module_name] - (case (<text>.result (regex^ current_module) - pattern) - {try.#Failure error} - (meta.failure (format "Error while parsing regular-expression:" //.new_line - error)) - - {try.#Success regex} - (in (list regex))))) - -(syntax: .public (pattern [[pattern bindings] (<code>.form (<>.and <code>.text (<>.maybe <code>.any))) - body <code>.any - branches (<>.many <code>.any)]) - (with_symbols [g!temp] - (in (partial_list (` (^.multi (~ g!temp) - [((~! <text>.result) (..regex (~ (code.text pattern))) (~ g!temp)) - {try.#Success (~ (maybe.else g!temp bindings))}])) - body - branches)))) +(def: .public regex + (syntax (_ [pattern <code>.text]) + (do meta.monad + [current_module meta.current_module_name] + (case (<text>.result (regex^ current_module) + pattern) + {try.#Failure error} + (meta.failure (format "Error while parsing regular-expression:" //.new_line + error)) + + {try.#Success regex} + (in (list regex)))))) + +(def: .public pattern + (syntax (_ [[pattern bindings] (<code>.form (<>.and <code>.text (<>.maybe <code>.any))) + body <code>.any + branches (<>.many <code>.any)]) + (with_symbols [g!temp] + (in (partial_list (` (^.multi (~ g!temp) + [((~! <text>.result) (..regex (~ (code.text pattern))) (~ g!temp)) + {try.#Success (~ (maybe.else g!temp bindings))}])) + body + branches))))) diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index 462f7a4bb..64f1cb80f 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -28,7 +28,7 @@ [macro ["^" pattern] ["[0]" template] - ["[0]" syntax (.only syntax:)] + ["[0]" syntax (.only syntax)] ["[0]" code]] [math [number @@ -522,11 +522,12 @@ {try.#Failure _} (exception.except ..cannot_represent_value type))) -(syntax: .public (private [definition <code>.symbol]) - (let [[module _] definition] - (in (list (` ("lux in-module" - (~ (code.text module)) - (~ (code.symbol definition)))))))) +(def: .public private + (syntax (_ [definition <code>.symbol]) + (let [[module _] definition] + (in (list (` ("lux in-module" + (~ (code.text module)) + (~ (code.symbol definition))))))))) (def: .public (log! message) (-> Text Any) @@ -538,11 +539,12 @@ "Location" (%.location location) "Type" (%.type type))) -(syntax: .public (hole []) - (do meta.monad - [location meta.location - expectedT meta.expected_type] - (function.constant (exception.except ..type_hole [location expectedT])))) +(def: .public hole + (syntax (_ []) + (do meta.monad + [location meta.location + expectedT meta.expected_type] + (function.constant (exception.except ..type_hole [location expectedT]))))) (type: Target [Text (Maybe Code)]) @@ -558,44 +560,45 @@ (exception.report "Name" (%.text name))) -(syntax: .public (here [targets (is (<code>.Parser (List Target)) - (|> ..target - <>.some - (<>.else (list))))]) - (do [! meta.monad] - [location meta.location - locals meta.locals - .let [environment (|> locals - list.together - ... The list is reversed to make sure that, when building the dictionary, - ... later bindings overshadow earlier ones if they have the same name. - list.reversed - (dictionary.of_list text.hash))] - targets (is (Meta (List Target)) - (case targets - {.#End} - (|> environment - dictionary.keys - (list#each (function (_ local) [local {.#None}])) - in) - - _ - (monad.each ! (function (_ [name format]) - (if (dictionary.key? environment name) - (in [name format]) - (function.constant (exception.except ..unknown_local_binding [name])))) - targets)))] - (in (list (` (..log! ("lux text concat" - (~ (code.text (%.format (%.location location) text.new_line))) - ((~! exception.report) - (~+ (|> targets - (list#each (function (_ [name format]) - (let [format (case format - {.#None} - (` (~! ..inspection)) - - {.#Some format} - format)] - (list (code.text name) - (` ((~ format) (~ (code.local name)))))))) - list#conjoint)))))))))) +(def: .public here + (syntax (_ [targets (is (<code>.Parser (List Target)) + (|> ..target + <>.some + (<>.else (list))))]) + (do [! meta.monad] + [location meta.location + locals meta.locals + .let [environment (|> locals + list.together + ... The list is reversed to make sure that, when building the dictionary, + ... later bindings overshadow earlier ones if they have the same name. + list.reversed + (dictionary.of_list text.hash))] + targets (is (Meta (List Target)) + (case targets + {.#End} + (|> environment + dictionary.keys + (list#each (function (_ local) [local {.#None}])) + in) + + _ + (monad.each ! (function (_ [name format]) + (if (dictionary.key? environment name) + (in [name format]) + (function.constant (exception.except ..unknown_local_binding [name])))) + targets)))] + (in (list (` (..log! ("lux text concat" + (~ (code.text (%.format (%.location location) text.new_line))) + ((~! exception.report) + (~+ (|> targets + (list#each (function (_ [name format]) + (let [format (case format + {.#None} + (` (~! ..inspection)) + + {.#Some format} + format)] + (list (code.text name) + (` ((~ format) (~ (code.local name)))))))) + list#conjoint))))))))))) diff --git a/stdlib/source/library/lux/documentation.lux b/stdlib/source/library/lux/documentation.lux index b4bdbecbe..8a67b4805 100644 --- a/stdlib/source/library/lux/documentation.lux +++ b/stdlib/source/library/lux/documentation.lux @@ -22,7 +22,7 @@ [format ["md" markdown (.only Markdown Block)]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["^" pattern] ["[0]" code] ["[0]" template]] @@ -498,75 +498,75 @@ (<code>.form (<>.and ..qualified_symbol (<>.some (<code>.local)))))) -(syntax: (minimal_definition_documentation - [[name parameters] ..declaration]) - (do meta.monad - [.let [g!module (code.text (product.left name))] - [[_ def_type def_value]] (meta.export name) - tags (meta.tags_of name)] - (with_expansions [<\n> (~! text.\n)] - (macro.with_symbols [g!type] - (in (list (` (all ((~! md.then)) - ... Name - (<| ((~! md.heading/3)) - (~ (code.text (%.code (let [g!name (|> name product.right code.local)] - (case parameters - {.#End} - g!name - - _ - (` ((~ g!name) (~+ (list#each code.local parameters)))))))))) - ... Type - (let [(~ g!type) ("lux in-module" +(def: minimal_definition_documentation + (syntax (_ [[name parameters] ..declaration]) + (do meta.monad + [.let [g!module (code.text (product.left name))] + [[_ def_type def_value]] (meta.export name) + tags (meta.tags_of name)] + (with_expansions [<\n> (~! text.\n)] + (macro.with_symbols [g!type] + (in (list (` (all ((~! md.then)) + ... Name + (<| ((~! md.heading/3)) + (~ (code.text (%.code (let [g!name (|> name product.right code.local)] + (case parameters + {.#End} + g!name + + _ + (` ((~ g!name) (~+ (list#each code.local parameters)))))))))) + ... Type + (let [(~ g!type) ("lux in-module" + (~ g!module) + (.type_of (~ (code.symbol name))))] + ((~! md.code) "clojure" + (~ (if (type#= .Type def_type) + (` (|> (~ (code.symbol name)) + (as .Type) + ((~! type.anonymous)) + ((~! ..type_definition) (~ g!module) - (.type_of (~ (code.symbol name))))] - ((~! md.code) "clojure" - (~ (if (type#= .Type def_type) - (` (|> (~ (code.symbol name)) - (as .Type) - ((~! type.anonymous)) - ((~! ..type_definition) - (~ g!module) - [(~ (code.text (product.right name))) (list (~+ (list#each code.text parameters)))] - (.list (~+ (|> tags - (maybe.else (list)) - (list#each (|>> product.right code.text)))))) - ((~! %.format) - ((~! ..single_line_comment) ((~! ..type) (~ g!module) (~ g!type))) - <\n>))) - (` ((~! ..type) (~ g!module) (~ g!type)))))))) - ))))))) - -(syntax: (definition_documentation - [[name parameters] ..declaration - description ..description - examples (<>.some ..example)]) - (with_expansions [<\n> (~! text.\n)] - (in (list (` (all ((~! md.then)) - ((~! ..minimal_definition_documentation) - ((~ (code.symbol name)) - (~+ (list#each code.local parameters)))) - ... Description - (~+ (case description - {.#Some description} - (list (` (<| ((~! md.paragraph)) - ((~! md.text)) - (~ description)))) - - {.#None} - (list))) - ... Examples - (~+ (case examples - {.#End} - (list) - - _ - (list (` (<| ((~! md.code) "clojure") - ((~! %.format) - (~+ (|> examples - (list#each (..example_documentation (product.left name))) - (list.interposed ..example_separator)))))))))) - ))))) + [(~ (code.text (product.right name))) (list (~+ (list#each code.text parameters)))] + (.list (~+ (|> tags + (maybe.else (list)) + (list#each (|>> product.right code.text)))))) + ((~! %.format) + ((~! ..single_line_comment) ((~! ..type) (~ g!module) (~ g!type))) + <\n>))) + (` ((~! ..type) (~ g!module) (~ g!type)))))))) + )))))))) + +(def: definition_documentation + (syntax (_ [[name parameters] ..declaration + description ..description + examples (<>.some ..example)]) + (with_expansions [<\n> (~! text.\n)] + (in (list (` (all ((~! md.then)) + ((~! ..minimal_definition_documentation) + ((~ (code.symbol name)) + (~+ (list#each code.local parameters)))) + ... Description + (~+ (case description + {.#Some description} + (list (` (<| ((~! md.paragraph)) + ((~! md.text)) + (~ description)))) + + {.#None} + (list))) + ... Examples + (~+ (case examples + {.#End} + (list) + + _ + (list (` (<| ((~! md.code) "clojure") + ((~! %.format) + (~+ (|> examples + (list#each (..example_documentation (product.left name))) + (list.interposed ..example_separator)))))))))) + )))))) (type: .public Definition (Record @@ -580,24 +580,26 @@ #expected (Set Text) #definitions (List Definition)])) -(syntax: .public (default [[name parameters] ..declaration]) - (let [[_ short] name] - (in (list (` (is (.List ..Definition) - (list [..#definition (~ (code.text short)) - ..#documentation ((~! ..minimal_definition_documentation) - ((~ (code.symbol name)) - (~+ (list#each code.local parameters))))]))))))) - -(syntax: .public (documentation: [[name parameters] ..declaration - extra (<>.some <code>.any)]) - (let [[_ short] name] - (in (list (` (.def: .public (~ (code.local short)) - (.List ..Definition) - (.list [..#definition (~ (code.text short)) - ..#documentation ((~! ..definition_documentation) - ((~ (code.symbol name)) - (~+ (list#each code.local parameters))) - (~+ extra))]))))))) +(def: .public default + (syntax (_ [[name parameters] ..declaration]) + (let [[_ short] name] + (in (list (` (is (.List ..Definition) + (list [..#definition (~ (code.text short)) + ..#documentation ((~! ..minimal_definition_documentation) + ((~ (code.symbol name)) + (~+ (list#each code.local parameters))))])))))))) + +(def: .public documentation: + (syntax (_ [[name parameters] ..declaration + extra (<>.some <code>.any)]) + (let [[_ short] name] + (in (list (` (.def: .public (~ (code.local short)) + (.List ..Definition) + (.list [..#definition (~ (code.text short)) + ..#documentation ((~! ..definition_documentation) + ((~ (code.symbol name)) + (~+ (list#each code.local parameters))) + (~+ extra))])))))))) (def: definitions_documentation (-> (List Definition) (Markdown Block)) @@ -624,24 +626,25 @@ (|>> (text.all_split_by ..expected_separator) (set.of_list text.hash))) -(syntax: .public (module [[name _] ..qualified_symbol - description <code>.any - definitions (<code>.tuple (<>.some <code>.any)) - subs (<code>.tuple (<>.some <code>.any))]) - (do meta.monad - [expected (meta.exports name)] - (in (list (` (is (List Module) - (partial_list [..#module (~ (code.text name)) - ..#description (~ description) - ..#expected ((~! ..expected) - (~ (code.text (|> expected - (list#each product.left) - ..expected_format)))) - ..#definitions ((~! list.together) (list (~+ definitions)))] - (all (at (~! list.monoid) (~' composite)) - (is (List Module) - (at (~! list.monoid) (~' identity))) - (~+ subs))))))))) +(def: .public module + (syntax (_ [[name _] ..qualified_symbol + description <code>.any + definitions (<code>.tuple (<>.some <code>.any)) + subs (<code>.tuple (<>.some <code>.any))]) + (do meta.monad + [expected (meta.exports name)] + (in (list (` (is (List Module) + (partial_list [..#module (~ (code.text name)) + ..#description (~ description) + ..#expected ((~! ..expected) + (~ (code.text (|> expected + (list#each product.left) + ..expected_format)))) + ..#definitions ((~! list.together) (list (~+ definitions)))] + (all (at (~! list.monoid) (~' composite)) + (is (List Module) + (at (~! list.monoid) (~' identity))) + (~+ subs)))))))))) (def: listing (-> (List Text) (Markdown Block)) diff --git a/stdlib/source/library/lux/extension.lux b/stdlib/source/library/lux/extension.lux index 0acba2133..fd4781f84 100644 --- a/stdlib/source/library/lux/extension.lux +++ b/stdlib/source/library/lux/extension.lux @@ -13,7 +13,7 @@ [collection ["[0]" list (.open: "[1]#[0]" functor)]]] [macro (.only with_symbols) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [tool [compiler @@ -37,26 +37,27 @@ (<c>.tuple (<>.some <c>.any))))) (template [<any> <end> <and> <result> <extension> <name>] - [(syntax: .public (<name> [[name extension phase archive inputs] (..declaration (` <any>)) - body <c>.any]) - (let [g!name (code.local extension) - g!phase (code.local phase) - g!archive (code.local archive)] - (with_symbols [g!handler g!inputs g!error g!_] - (in (list (` (<extension> (~ name) - (.function ((~ g!handler) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs)) - (.case ((~! <result>) - ((~! monad.do) (~! <>.monad) - [(~+ inputs) - (~ g!_) <end>] - (.at (~! <>.monad) (~' in) (~ body))) - (~ g!inputs)) - {.#Right (~ g!_)} - (~ g!_) + [(def: .public <name> + (syntax (_ [[name extension phase archive inputs] (..declaration (` <any>)) + body <c>.any]) + (let [g!name (code.local extension) + g!phase (code.local phase) + g!archive (code.local archive)] + (with_symbols [g!handler g!inputs g!error g!_] + (in (list (` (<extension> (~ name) + (.function ((~ g!handler) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs)) + (.case ((~! <result>) + ((~! monad.do) (~! <>.monad) + [(~+ inputs) + (~ g!_) <end>] + (.at (~! <>.monad) (~' in) (~ body))) + (~ g!inputs)) + {.#Right (~ g!_)} + (~ g!_) - {.#Left (~ g!error)} - ((~! phase.failure) (~ g!error))) - ))))))))] + {.#Left (~ g!error)} + ((~! phase.failure) (~ g!error))) + )))))))))] [<c>.any <c>.end <c>.and <c>.result "lux def analysis" analysis:] [<a>.any <a>.end <a>.and <a>.result "lux def synthesis" synthesis:] diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index f578c11bb..ebf0a980e 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -20,7 +20,7 @@ ["[0]" list (.open: "[1]#[0]" monad mix monoid)] ["[0]" dictionary (.only Dictionary)]]] [macro (.only with_symbols) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["^" pattern] ["[0]" code] ["[0]" template]] @@ -1196,112 +1196,121 @@ (Type Class) (jvm.class "java.lang.Object" (list))) -(syntax: .public (class: [.let [! <>.monad] - im inheritance_modifier^ - [full_class_name class_vars] (at ! each parser.declaration ..declaration^) - super (<>.else $Object - (class^ class_vars)) - interfaces (<>.else (list) - (<code>.tuple (<>.some (class^ class_vars)))) - annotations ..annotations^ - fields (<>.some (..field_decl^ class_vars)) - methods (<>.some (..method_def^ class_vars))]) - (do meta.monad - [.let [fully_qualified_class_name full_class_name - method_parser (.is (Parser Code) - (|> methods - (list#each (method->parser class_vars fully_qualified_class_name)) - (list#mix <>.either (<>.failure ""))))]] - (in (list (` ("jvm class" +(def: .public class: + (syntax (_ [.let [! <>.monad] + im inheritance_modifier^ + [full_class_name class_vars] (at ! each parser.declaration ..declaration^) + super (<>.else $Object + (class^ class_vars)) + interfaces (<>.else (list) + (<code>.tuple (<>.some (class^ class_vars)))) + annotations ..annotations^ + fields (<>.some (..field_decl^ class_vars)) + methods (<>.some (..method_def^ class_vars))]) + (do meta.monad + [.let [fully_qualified_class_name full_class_name + method_parser (.is (Parser Code) + (|> methods + (list#each (method->parser class_vars fully_qualified_class_name)) + (list#mix <>.either (<>.failure ""))))]] + (in (list (` ("jvm class" + (~ (declaration$ (jvm.declaration full_class_name class_vars))) + (~ (class$ super)) + [(~+ (list#each class$ interfaces))] + (~ (inheritance_modifier$ im)) + [(~+ (list#each annotation$ annotations))] + [(~+ (list#each field_decl$ fields))] + [(~+ (list#each (method_def$ fully_qualified_class_name method_parser super fields) methods))]))))))) + +(def: .public interface: + (syntax (_ [.let [! <>.monad] + [full_class_name class_vars] (at ! each parser.declaration ..declaration^) + supers (<>.else (list) + (<code>.tuple (<>.some (class^ class_vars)))) + annotations ..annotations^ + members (<>.some (..method_decl^ class_vars))]) + (in (list (` ("jvm class interface" (~ (declaration$ (jvm.declaration full_class_name class_vars))) + [(~+ (list#each class$ supers))] + [(~+ (list#each annotation$ annotations))] + (~+ (list#each method_decl$ members)))))))) + +(def: .public object + (syntax (_ [class_vars ..vars^ + super (<>.else $Object + (class^ class_vars)) + interfaces (<>.else (list) + (<code>.tuple (<>.some (class^ class_vars)))) + constructor_args (..constructor_args^ class_vars) + methods (<>.some ..overriden_method_def^)]) + (in (list (` ("jvm class anonymous" + [(~+ (list#each var$ class_vars))] (~ (class$ super)) [(~+ (list#each class$ interfaces))] - (~ (inheritance_modifier$ im)) - [(~+ (list#each annotation$ annotations))] - [(~+ (list#each field_decl$ fields))] - [(~+ (list#each (method_def$ fully_qualified_class_name method_parser super fields) methods))])))))) - -(syntax: .public (interface: [.let [! <>.monad] - [full_class_name class_vars] (at ! each parser.declaration ..declaration^) - supers (<>.else (list) - (<code>.tuple (<>.some (class^ class_vars)))) - annotations ..annotations^ - members (<>.some (..method_decl^ class_vars))]) - (in (list (` ("jvm class interface" - (~ (declaration$ (jvm.declaration full_class_name class_vars))) - [(~+ (list#each class$ supers))] - [(~+ (list#each annotation$ annotations))] - (~+ (list#each method_decl$ members))))))) - -(syntax: .public (object [class_vars ..vars^ - super (<>.else $Object - (class^ class_vars)) - interfaces (<>.else (list) - (<code>.tuple (<>.some (class^ class_vars)))) - constructor_args (..constructor_args^ class_vars) - methods (<>.some ..overriden_method_def^)]) - (in (list (` ("jvm class anonymous" - [(~+ (list#each var$ class_vars))] - (~ (class$ super)) - [(~+ (list#each class$ interfaces))] - [(~+ (list#each constructor_arg$ constructor_args))] - [(~+ (list#each (method_def$ "" (<>.failure "") super (list)) methods))]))))) - -(syntax: .public (null []) - (in (list (` ("jvm object null"))))) + [(~+ (list#each constructor_arg$ constructor_args))] + [(~+ (list#each (method_def$ "" (<>.failure "") super (list)) methods))])))))) + +(def: .public null + (syntax (_ []) + (in (list (` ("jvm object null")))))) (def: .public (null? obj) (-> (.Primitive "java.lang.Object") Bit) ("jvm object null?" obj)) -(syntax: .public (??? [expr <code>.any]) - (with_symbols [g!temp] - (in (list (` (let [(~ g!temp) (~ expr)] - (if (not ("jvm object null?" (~ g!temp))) - {.#Some (~ g!temp)} - {.#None}))))))) +(def: .public ??? + (syntax (_ [expr <code>.any]) + (with_symbols [g!temp] + (in (list (` (let [(~ g!temp) (~ expr)] + (if (not ("jvm object null?" (~ g!temp))) + {.#Some (~ g!temp)} + {.#None})))))))) + +(def: .public !!! + (syntax (_ [expr <code>.any]) + (with_symbols [g!value] + (in (list (` (.case (~ expr) + {.#Some (~ g!value)} + (~ g!value) + + {.#None} + ("jvm object null")))))))) + +(def: .public as + (syntax (_ [class (..type^ (list)) + unchecked (<>.maybe <code>.any)]) + (with_symbols [g!_ g!unchecked] + (let [class_name (..reflection class) + class_type (` (.Primitive (~ (code.text class_name)))) + check_type (` (.Maybe (~ class_type))) + check_code (` (if ("jvm object instance?" (~ (code.text class_name)) (~ g!unchecked)) + {.#Some (.as (~ class_type) + (~ g!unchecked))} + {.#None}))] + (case unchecked + {.#Some unchecked} + (in (list (` (.is (~ check_type) + (let [(~ g!unchecked) (~ unchecked)] + (~ check_code)))))) -(syntax: .public (!!! [expr <code>.any]) - (with_symbols [g!value] - (in (list (` (.case (~ expr) - {.#Some (~ g!value)} - (~ g!value) - - {.#None} - ("jvm object null"))))))) - -(syntax: .public (as [class (..type^ (list)) - unchecked (<>.maybe <code>.any)]) - (with_symbols [g!_ g!unchecked] - (let [class_name (..reflection class) - class_type (` (.Primitive (~ (code.text class_name)))) - check_type (` (.Maybe (~ class_type))) - check_code (` (if ("jvm object instance?" (~ (code.text class_name)) (~ g!unchecked)) - {.#Some (.as (~ class_type) - (~ g!unchecked))} - {.#None}))] - (case unchecked - {.#Some unchecked} - (in (list (` (.is (~ check_type) - (let [(~ g!unchecked) (~ unchecked)] - (~ check_code)))))) - - {.#None} - (in (list (` (.is (-> (.Primitive "java.lang.Object") (~ check_type)) - (function ((~ g!_) (~ g!unchecked)) - (~ check_code)))))) - )))) - -(syntax: .public (synchronized [lock <code>.any - body <code>.any]) - (in (list (` ("jvm object synchronized" (~ lock) (~ body)))))) - -(syntax: .public (do_to [obj <code>.any - methods (<>.some partial_call^)]) - (with_symbols [g!obj] - (in (list (` (let [(~ g!obj) (~ obj)] - (exec (~+ (list#each (complete_call$ g!obj) methods)) - (~ g!obj)))))))) + {.#None} + (in (list (` (.is (-> (.Primitive "java.lang.Object") (~ check_type)) + (function ((~ g!_) (~ g!unchecked)) + (~ check_code)))))) + ))))) + +(def: .public synchronized + (syntax (_ [lock <code>.any + body <code>.any]) + (in (list (` ("jvm object synchronized" (~ lock) (~ body))))))) + +(def: .public do_to + (syntax (_ [obj <code>.any + methods (<>.some partial_call^)]) + (with_symbols [g!obj] + (in (list (` (let [(~ g!obj) (~ obj)] + (exec (~+ (list#each (complete_call$ g!obj) methods)) + (~ g!obj))))))))) (def: (class_import$ declaration) (-> (Type Declaration) Code) @@ -1521,8 +1530,9 @@ (with_return_maybe member true classT) (with_return_try member) (with_return_io member))]] - (in (list (` ((~! syntax:) ((~ def_name) [(~+ (syntax_inputs (list#each product.right arg_function_inputs)))]) - ((~' in) (.list (.` (~ jvm_interop))))))))) + (in (list (` (def: (~ def_name) + ((~! syntax) ((~ def_name) [(~+ (syntax_inputs (list#each product.right arg_function_inputs)))]) + ((~' in) (.list (.` (~ jvm_interop)))))))))) {#MethodDecl [commons method]} (with_symbols [g!obj] @@ -1575,9 +1585,10 @@ (|> callC (with_return_try member) (with_return_io member))))]] - (in (list (` ((~! syntax:) ((~ def_name) [(~+ (syntax_inputs (list#each product.right arg_function_inputs))) - (~+ (syntax_inputs object_ast))]) - ((~' in) (.list (.` (~ jvm_interop)))))))))) + (in (list (` (def: (~ def_name) + ((~! syntax) ((~ def_name) [(~+ (syntax_inputs (list#each product.right arg_function_inputs))) + (~+ (syntax_inputs object_ast))]) + ((~' in) (.list (.` (~ jvm_interop))))))))))) {#FieldAccessDecl fad} (do meta.monad @@ -1599,8 +1610,9 @@ getter_body (if _#import_field_setter? (` ((~! io.io) (~ getter_body))) getter_body)] - (in (` ((~! syntax:) (~ getter_call) - ((~' in) (.list (.` (~ getter_body))))))))) + (in (` (def: (~ getter_name) + ((~! syntax) (~ getter_call) + ((~' in) (.list (.` (~ getter_body)))))))))) setter_interop (.is (Meta (List Code)) (if _#import_field_setter? (with_symbols [g!obj g!value] @@ -1619,8 +1631,9 @@ (if _#import_field_static? (list) (list (..un_quoted g!obj))))] - (in (list (` ((~! syntax:) (~ setter_call) - ((~' in) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value)))))))))))) + (in (list (` (def: (~ setter_name) + ((~! syntax) (~ setter_call) + ((~' in) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value))))))))))))) (in (list))))] (in (partial_list getter_interop setter_interop))) ))) @@ -1659,40 +1672,42 @@ {.#Left _} (meta.failure (format "Unknown class: " class_name))))) -(syntax: .public (import [declaration ..declaration^ - .let [[class_name class_type_vars] (parser.declaration declaration)] - import_format <code>.text - members (<>.some (..import_member_decl^ class_type_vars))]) - (do [! meta.monad] - [kind (class_kind declaration) - =members (|> members - (list#each (|>> [import_format])) - (monad.each ! (member_import$ class_type_vars kind declaration)))] - (in (partial_list (class_import$ declaration) (list#conjoint =members))))) - -(syntax: .public (array [type (..type^ (list)) - size <code>.any]) - (let [g!size (` (|> (~ size) - (.is .Nat) - (.as (.Primitive (~ (code.text box.long)))) - "jvm object cast" - "jvm conversion long-to-int"))] - (`` (cond (~~ (template [<primitive> <array_op>] - [(at jvm.equivalence = <primitive> type) - (in (list (` (<array_op> (~ g!size)))))] - - [jvm.boolean "jvm array new boolean"] - [jvm.byte "jvm array new byte"] - [jvm.short "jvm array new short"] - [jvm.int "jvm array new int"] - [jvm.long "jvm array new long"] - [jvm.float "jvm array new float"] - [jvm.double "jvm array new double"] - [jvm.char "jvm array new char"])) - ... else - (in (list (` (.as ((~! array.Array) (~ (value_type {#ManualPrM} type))) - (.is (~ (value_type {#ManualPrM} (jvm.array type))) - ("jvm array new object" (~ g!size))))))))))) +(def: .public import + (syntax (_ [declaration ..declaration^ + .let [[class_name class_type_vars] (parser.declaration declaration)] + import_format <code>.text + members (<>.some (..import_member_decl^ class_type_vars))]) + (do [! meta.monad] + [kind (class_kind declaration) + =members (|> members + (list#each (|>> [import_format])) + (monad.each ! (member_import$ class_type_vars kind declaration)))] + (in (partial_list (class_import$ declaration) (list#conjoint =members)))))) + +(def: .public array + (syntax (_ [type (..type^ (list)) + size <code>.any]) + (let [g!size (` (|> (~ size) + (.is .Nat) + (.as (.Primitive (~ (code.text box.long)))) + "jvm object cast" + "jvm conversion long-to-int"))] + (`` (cond (~~ (template [<primitive> <array_op>] + [(at jvm.equivalence = <primitive> type) + (in (list (` (<array_op> (~ g!size)))))] + + [jvm.boolean "jvm array new boolean"] + [jvm.byte "jvm array new byte"] + [jvm.short "jvm array new short"] + [jvm.int "jvm array new int"] + [jvm.long "jvm array new long"] + [jvm.float "jvm array new float"] + [jvm.double "jvm array new double"] + [jvm.char "jvm array new char"])) + ... else + (in (list (` (.as ((~! array.Array) (~ (value_type {#ManualPrM} type))) + (.is (~ (value_type {#ManualPrM} (jvm.array type))) + ("jvm array new object" (~ g!size)))))))))))) (exception: .public (cannot_convert_to_jvm_type [type .Type]) (exception.report @@ -1797,140 +1812,146 @@ _ <failure>)))) -(syntax: .public (length [array <code>.any]) - (case array - [_ {.#Symbol array_name}] - (do meta.monad - [array_type (meta.type array_name) - context meta.type_context - array_jvm_type (lux_type->jvm_type context array_type) - .let [g!extension (code.text (`` (cond (~~ (template [<primitive> <extension>] - [(at jvm.equivalence = - (jvm.array <primitive>) - array_jvm_type) - <extension>] - - [jvm.boolean "jvm array length boolean"] - [jvm.byte "jvm array length byte"] - [jvm.short "jvm array length short"] - [jvm.int "jvm array length int"] - [jvm.long "jvm array length long"] - [jvm.float "jvm array length float"] - [jvm.double "jvm array length double"] - [jvm.char "jvm array length char"])) - - ... else - "jvm array length object")))]] - (in (list (` (.|> ((~ g!extension) (~ array)) - "jvm conversion int-to-long" - "jvm object cast" - (.is (.Primitive (~ (code.text box.long)))) - (.as .Nat)))))) +(def: .public length + (syntax (_ [array <code>.any]) + (case array + [_ {.#Symbol array_name}] + (do meta.monad + [array_type (meta.type array_name) + context meta.type_context + array_jvm_type (lux_type->jvm_type context array_type) + .let [g!extension (code.text (`` (cond (~~ (template [<primitive> <extension>] + [(at jvm.equivalence = + (jvm.array <primitive>) + array_jvm_type) + <extension>] + + [jvm.boolean "jvm array length boolean"] + [jvm.byte "jvm array length byte"] + [jvm.short "jvm array length short"] + [jvm.int "jvm array length int"] + [jvm.long "jvm array length long"] + [jvm.float "jvm array length float"] + [jvm.double "jvm array length double"] + [jvm.char "jvm array length char"])) + + ... else + "jvm array length object")))]] + (in (list (` (.|> ((~ g!extension) (~ array)) + "jvm conversion int-to-long" + "jvm object cast" + (.is (.Primitive (~ (code.text box.long)))) + (.as .Nat)))))) - _ - (with_symbols [g!array] - (in (list (` (let [(~ g!array) (~ array)] - (..length (~ g!array))))))))) - -(syntax: .public (read! [idx <code>.any - array <code>.any]) - (case array - [_ {.#Symbol array_name}] - (do meta.monad - [array_type (meta.type array_name) - context meta.type_context - array_jvm_type (lux_type->jvm_type context array_type) - .let [g!idx (` (.|> (~ idx) - (.is .Nat) - (.as (.Primitive (~ (code.text box.long)))) - "jvm object cast" - "jvm conversion long-to-int"))]] - (`` (cond (~~ (template [<primitive> <extension> <box>] - [(at jvm.equivalence = - (jvm.array <primitive>) - array_jvm_type) - (in (list (` (.|> (<extension> (~ g!idx) (~ array)) - "jvm object cast" - (.is (.Primitive (~ (code.text <box>))))))))] - - [jvm.boolean "jvm array read boolean" box.boolean] - [jvm.byte "jvm array read byte" box.byte] - [jvm.short "jvm array read short" box.short] - [jvm.int "jvm array read int" box.int] - [jvm.long "jvm array read long" box.long] - [jvm.float "jvm array read float" box.float] - [jvm.double "jvm array read double" box.double] - [jvm.char "jvm array read char" box.char])) - - ... else - (in (list (` ("jvm array read object" (~ g!idx) (~ array)))))))) + _ + (with_symbols [g!array] + (in (list (` (let [(~ g!array) (~ array)] + (..length (~ g!array)))))))))) + +(def: .public read! + (syntax (_ [idx <code>.any + array <code>.any]) + (case array + [_ {.#Symbol array_name}] + (do meta.monad + [array_type (meta.type array_name) + context meta.type_context + array_jvm_type (lux_type->jvm_type context array_type) + .let [g!idx (` (.|> (~ idx) + (.is .Nat) + (.as (.Primitive (~ (code.text box.long)))) + "jvm object cast" + "jvm conversion long-to-int"))]] + (`` (cond (~~ (template [<primitive> <extension> <box>] + [(at jvm.equivalence = + (jvm.array <primitive>) + array_jvm_type) + (in (list (` (.|> (<extension> (~ g!idx) (~ array)) + "jvm object cast" + (.is (.Primitive (~ (code.text <box>))))))))] + + [jvm.boolean "jvm array read boolean" box.boolean] + [jvm.byte "jvm array read byte" box.byte] + [jvm.short "jvm array read short" box.short] + [jvm.int "jvm array read int" box.int] + [jvm.long "jvm array read long" box.long] + [jvm.float "jvm array read float" box.float] + [jvm.double "jvm array read double" box.double] + [jvm.char "jvm array read char" box.char])) + + ... else + (in (list (` ("jvm array read object" (~ g!idx) (~ array)))))))) - _ - (with_symbols [g!array] - (in (list (` (let [(~ g!array) (~ array)] - (..read! (~ idx) (~ g!array))))))))) - -(syntax: .public (write! [idx <code>.any - value <code>.any - array <code>.any]) - (case array - [_ {.#Symbol array_name}] - (do meta.monad - [array_type (meta.type array_name) - context meta.type_context - array_jvm_type (lux_type->jvm_type context array_type) - .let [g!idx (` (.|> (~ idx) - (.is .Nat) - (.as (.Primitive (~ (code.text box.long)))) - "jvm object cast" - "jvm conversion long-to-int"))]] - (`` (cond (~~ (template [<primitive> <extension> <box>] - [(at jvm.equivalence = - (jvm.array <primitive>) - array_jvm_type) - (let [g!value (` (.|> (~ value) - (.as (.Primitive (~ (code.text <box>)))) - "jvm object cast"))] - (in (list (` (<extension> (~ g!idx) (~ g!value) (~ array))))))] - - [jvm.boolean "jvm array write boolean" box.boolean] - [jvm.byte "jvm array write byte" box.byte] - [jvm.short "jvm array write short" box.short] - [jvm.int "jvm array write int" box.int] - [jvm.long "jvm array write long" box.long] - [jvm.float "jvm array write float" box.float] - [jvm.double "jvm array write double" box.double] - [jvm.char "jvm array write char" box.char])) - - ... else - (in (list (` ("jvm array write object" (~ g!idx) (~ value) (~ array)))))))) + _ + (with_symbols [g!array] + (in (list (` (let [(~ g!array) (~ array)] + (..read! (~ idx) (~ g!array)))))))))) + +(def: .public write! + (syntax (_ [idx <code>.any + value <code>.any + array <code>.any]) + (case array + [_ {.#Symbol array_name}] + (do meta.monad + [array_type (meta.type array_name) + context meta.type_context + array_jvm_type (lux_type->jvm_type context array_type) + .let [g!idx (` (.|> (~ idx) + (.is .Nat) + (.as (.Primitive (~ (code.text box.long)))) + "jvm object cast" + "jvm conversion long-to-int"))]] + (`` (cond (~~ (template [<primitive> <extension> <box>] + [(at jvm.equivalence = + (jvm.array <primitive>) + array_jvm_type) + (let [g!value (` (.|> (~ value) + (.as (.Primitive (~ (code.text <box>)))) + "jvm object cast"))] + (in (list (` (<extension> (~ g!idx) (~ g!value) (~ array))))))] + + [jvm.boolean "jvm array write boolean" box.boolean] + [jvm.byte "jvm array write byte" box.byte] + [jvm.short "jvm array write short" box.short] + [jvm.int "jvm array write int" box.int] + [jvm.long "jvm array write long" box.long] + [jvm.float "jvm array write float" box.float] + [jvm.double "jvm array write double" box.double] + [jvm.char "jvm array write char" box.char])) + + ... else + (in (list (` ("jvm array write object" (~ g!idx) (~ value) (~ array)))))))) - _ - (with_symbols [g!array] - (in (list (` (let [(~ g!array) (~ array)] - (..write! (~ idx) (~ value) (~ g!array))))))))) + _ + (with_symbols [g!array] + (in (list (` (let [(~ g!array) (~ array)] + (..write! (~ idx) (~ value) (~ g!array)))))))))) -(syntax: .public (class_for [type (..type^ (list))]) - (in (list (` ("jvm object class" (~ (code.text (..reflection type)))))))) +(def: .public class_for + (syntax (_ [type (..type^ (list))]) + (in (list (` ("jvm object class" (~ (code.text (..reflection type))))))))) -(syntax: .public (type [type (..type^ (list))]) - (in (list (..value_type {#ManualPrM} type)))) +(def: .public type + (syntax (_ [type (..type^ (list))]) + (in (list (..value_type {#ManualPrM} type))))) (exception: .public (cannot_cast_to_non_object [type (Type Value)]) (exception.report "Signature" (..signature type) "Reflection" (..reflection type))) -(syntax: .public (is [type (..type^ (list)) - object <code>.any]) - (case [(parser.array? type) - (parser.class? type)] - (^.or [{.#Some _} _] [_ {.#Some _}]) - (in (list (` (.is (~ (..value_type {#ManualPrM} type)) - ("jvm object cast" (~ object)))))) +(def: .public is + (syntax (_ [type (..type^ (list)) + object <code>.any]) + (case [(parser.array? type) + (parser.class? type)] + (^.or [{.#Some _} _] [_ {.#Some _}]) + (in (list (` (.is (~ (..value_type {#ManualPrM} type)) + ("jvm object cast" (~ object)))))) - _ - (meta.failure (exception.error ..cannot_cast_to_non_object [type])))) + _ + (meta.failure (exception.error ..cannot_cast_to_non_object [type]))))) (template [<forward> <from> <to> <backward>] [(template: .public (<forward> it) diff --git a/stdlib/source/library/lux/ffi.lux b/stdlib/source/library/lux/ffi.lux index 1ff34a943..510918308 100644 --- a/stdlib/source/library/lux/ffi.lux +++ b/stdlib/source/library/lux/ffi.lux @@ -17,7 +17,7 @@ [collection ["[0]" list (.open: "[1]#[0]" monad mix)]]] ["[0]" macro (.only with_symbols) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code] ["[0]" template]] ["@" target (.only) @@ -473,16 +473,17 @@ (..namespaced namespace class_name alias) code.local) :field: (the #anonymous it)] - (` ((~! syntax:) ((~ g!it) []) - (.at (~! meta.monad) (~' in) - (.list (`' (.exec - (~+ import!) - (.as (~ (..output_type :field:)) - (~ (<| (lux_optional :field:) - (for @.js (` (<constant> (~ (code.text (%.format (..host_path class_name) "." field))))) - @.ruby (` (<constant> (~ (code.text (%.format (..host_path class_name) "::" field))))) - (` (<get> (~ (code.text field)) - (~ (..imported class_name)))))))))))))))) + (` (def: (~ g!it) + ((~! syntax) ((~ g!it) []) + (.at (~! meta.monad) (~' in) + (.list (`' (.exec + (~+ import!) + (.as (~ (..output_type :field:)) + (~ (<| (lux_optional :field:) + (for @.js (` (<constant> (~ (code.text (%.format (..host_path class_name) "." field))))) + @.ruby (` (<constant> (~ (code.text (%.format (..host_path class_name) "::" field))))) + (` (<get> (~ (code.text field)) + (~ (..imported class_name))))))))))))))))) (def: (virtual_field_definition [class_name class_parameters] alias namespace it) (-> Declaration Alias Namespace (Named Output) Code) @@ -559,93 +560,96 @@ (static_method_definition import! class alias namespace (the #member it)) (virtual_method_definition class alias namespace (the #member it)))) - (syntax: .public (import [host_module (<>.maybe <code>.text) - it ..importP]) - (let [host_module_import! (is (List Code) - (case host_module - {.#Some host_module} - (list (` (<import> (~ (code.text host_module))))) - - {.#None} - (list)))] - (case it - {#Global it} - (in (list (..global_definition host_module_import! it))) - - {#Procedure it} - (in (list (..procedure_definition host_module_import! - (` (<constant> (~ (code.text (..host_path (the #name it)))))) - it))) - - {#Class it} - (let [class (the #declaration it) - alias (the #class_alias it) - [class_name class_parameters] class - namespace (the #namespace it) - g!class_variables (list#each code.local class_parameters) - declaration (` ((~ (code.local (maybe.else class_name alias))) - (~+ g!class_variables)))] - (in (partial_list (` (.type: (~ declaration) - (..Object (.Primitive (~ (code.text (..host_path class_name))) - [(~+ g!class_variables)])))) - (list#each (.function (_ member) - (`` (`` (case member - (~~ (for @.lua (~~ (these)) - @.ruby (~~ (these)) - (~~ (these {#Constructor it} - (..constructor_definition class alias namespace it))))) - - {#Field it} - (..field_definition host_module_import! class alias namespace it) - - {#Method it} - (..method_definition host_module_import! class alias namespace it))))) - (the #members it))))) - ))) + (def: .public import + (syntax (_ [host_module (<>.maybe <code>.text) + it ..importP]) + (let [host_module_import! (is (List Code) + (case host_module + {.#Some host_module} + (list (` (<import> (~ (code.text host_module))))) + + {.#None} + (list)))] + (case it + {#Global it} + (in (list (..global_definition host_module_import! it))) + + {#Procedure it} + (in (list (..procedure_definition host_module_import! + (` (<constant> (~ (code.text (..host_path (the #name it)))))) + it))) + + {#Class it} + (let [class (the #declaration it) + alias (the #class_alias it) + [class_name class_parameters] class + namespace (the #namespace it) + g!class_variables (list#each code.local class_parameters) + declaration (` ((~ (code.local (maybe.else class_name alias))) + (~+ g!class_variables)))] + (in (partial_list (` (.type: (~ declaration) + (..Object (.Primitive (~ (code.text (..host_path class_name))) + [(~+ g!class_variables)])))) + (list#each (.function (_ member) + (`` (`` (case member + (~~ (for @.lua (~~ (these)) + @.ruby (~~ (these)) + (~~ (these {#Constructor it} + (..constructor_definition class alias namespace it))))) + + {#Field it} + (..field_definition host_module_import! class alias namespace it) + + {#Method it} + (..method_definition host_module_import! class alias namespace it))))) + (the #members it))))) + )))) (for @.ruby (these) - (syntax: .public (function [[self inputs] (<code>.form - (all <>.and - <code>.local - (<code>.tuple (<>.some (<>.and <code>.any <code>.any))))) - type <code>.any - term <code>.any]) - (in (list (` (.<| (.as ..Function) - (<function> (~ (code.nat (list.size inputs)))) - (.as (.-> [(~+ (list.repeated (list.size inputs) (` .Any)))] - .Any)) - (.is (.-> [(~+ (list#each product.right inputs))] - (~ type))) - (.function ((~ (code.local self)) [(~+ (list#each product.left inputs))]) - (~ term)))))))) + (def: .public function + (syntax (_ [[self inputs] (<code>.form + (all <>.and + <code>.local + (<code>.tuple (<>.some (<>.and <code>.any <code>.any))))) + type <code>.any + term <code>.any]) + (in (list (` (.<| (.as ..Function) + (<function> (~ (code.nat (list.size inputs)))) + (.as (.-> [(~+ (list.repeated (list.size inputs) (` .Any)))] + .Any)) + (.is (.-> [(~+ (list#each product.right inputs))] + (~ type))) + (.function ((~ (code.local self)) [(~+ (list#each product.left inputs))]) + (~ term))))))))) (for @.js (these (template: .public (type_of object) [("js type-of" object)]) - (syntax: .public (global [type <code>.any - [head tail] (<code>.tuple (<>.and <code>.local (<>.some <code>.local)))]) - (with_symbols [g!_] - (let [global (` ("js constant" (~ (code.text head))))] - (case tail - {.#End} - (in (list (` (is (.Maybe (~ type)) - (case (..type_of (~ global)) - "undefined" - {.#None} - - (~ g!_) - {.#Some (as (~ type) (~ global))}))))) - - {.#Item [next tail]} - (let [separator "."] + (def: .public global + (syntax (_ [type <code>.any + [head tail] (<code>.tuple (<>.and <code>.local (<>.some <code>.local)))]) + (with_symbols [g!_] + (let [global (` ("js constant" (~ (code.text head))))] + (case tail + {.#End} (in (list (` (is (.Maybe (~ type)) (case (..type_of (~ global)) "undefined" {.#None} (~ g!_) - (..global (~ type) [(~ (code.local (%.format head "." next))) - (~+ (list#each code.local tail))]))))))))))) + {.#Some (as (~ type) (~ global))}))))) + + {.#Item [next tail]} + (let [separator "."] + (in (list (` (is (.Maybe (~ type)) + (case (..type_of (~ global)) + "undefined" + {.#None} + + (~ g!_) + (..global (~ type) [(~ (code.local (%.format head "." next))) + (~+ (list#each code.local tail))])))))))))))) (template: (!defined? <global>) [(.case (..global Any <global>) @@ -676,11 +680,12 @@ ... These extensions must be defined this way because importing any of the modules ... normally used when writing extensions would introduce a circular dependency ... because the Archive type depends on Binary, and that module depends on this ffi module. - (syntax: (extension_name []) - (do meta.monad - [module meta.current_module_name - unique_id meta.seed] - (in (list (code.text (%.format module " " (%.nat unique_id))))))) + (def: extension_name + (syntax (_ []) + (do meta.monad + [module meta.current_module_name + unique_id meta.seed] + (in (list (code.text (%.format module " " (%.nat unique_id)))))))) (with_expansions [<undefined> (..extension_name) <undefined?> (..extension_name)] diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux index 951d58f18..8aa106b28 100644 --- a/stdlib/source/library/lux/ffi.old.lux +++ b/stdlib/source/library/lux/ffi.old.lux @@ -21,7 +21,7 @@ ["[0]" array (.only Array)] ["[0]" list (.open: "[1]#[0]" monad mix monoid)]]] ["[0]" macro (.only with_symbols) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["^" pattern] ["[0]" code] ["[0]" template]] @@ -1198,117 +1198,126 @@ [#super_class_name "java/lang/Object" #super_class_params (list)]) -(syntax: .public (class: [im inheritance_modifier^ - class_decl ..class_decl^ - .let [full_class_name (product.left class_decl)] - .let [class_vars (product.right class_decl)] - super (<>.else object_super_class - (..super_class_decl^ class_vars)) - interfaces (<>.else (list) - (<code>.tuple (<>.some (..super_class_decl^ class_vars)))) - annotations ..annotations^ - fields (<>.some (..field_decl^ class_vars)) - methods (<>.some (..method_def^ class_vars))]) - (do meta.monad - [current_module meta.current_module_name - .let [fully_qualified_class_name (format (safe current_module) "." full_class_name) - field_parsers (list#each (field_parser fully_qualified_class_name) fields) - method_parsers (list#each (method_parser (product.right class_decl) fully_qualified_class_name) methods) - replacer (parser_replacer (list#mix <>.either - (<>.failure "") - (list#composite field_parsers method_parsers))) - def_code (format "jvm class:" - (spaced (list (class_decl$ class_decl) - (super_class_decl$ super) - (with_brackets (spaced (list#each super_class_decl$ interfaces))) - (inheritance_modifier$ im) - (with_brackets (spaced (list#each annotation$ annotations))) - (with_brackets (spaced (list#each field_decl$ fields))) - (with_brackets (spaced (list#each (method_def$ replacer super) methods))))))]] - (in (list (` ((~ (code.text def_code)))))))) - -(syntax: .public (interface: [class_decl ..class_decl^ - .let [class_vars (product.right class_decl)] - supers (<>.else (list) - (<code>.tuple (<>.some (..super_class_decl^ class_vars)))) - annotations ..annotations^ - members (<>.some (..method_decl^ class_vars))]) - (let [def_code (format "jvm interface:" - (spaced (list (class_decl$ class_decl) - (with_brackets (spaced (list#each super_class_decl$ supers))) - (with_brackets (spaced (list#each annotation$ annotations))) - (spaced (list#each method_decl$ members)))))] - (in (list (` ((~ (code.text def_code)))))))) - -(syntax: .public (object [class_vars (<code>.tuple (<>.some ..type_param^)) - super (<>.else object_super_class - (..super_class_decl^ class_vars)) - interfaces (<>.else (list) - (<code>.tuple (<>.some (..super_class_decl^ class_vars)))) - constructor_args (..constructor_args^ class_vars) - methods (<>.some ..overriden_method_def^)]) - (let [def_code (format "jvm anon-class:" - (spaced (list (super_class_decl$ super) - (with_brackets (spaced (list#each super_class_decl$ interfaces))) - (with_brackets (spaced (list#each constructor_arg$ constructor_args))) - (with_brackets (spaced (list#each (method_def$ function.identity super) methods))))))] - (in (list (` ((~ (code.text def_code)))))))) - -(syntax: .public (null []) - (in (list (` ("jvm object null"))))) +(def: .public class: + (syntax (_ [im inheritance_modifier^ + class_decl ..class_decl^ + .let [full_class_name (product.left class_decl)] + .let [class_vars (product.right class_decl)] + super (<>.else object_super_class + (..super_class_decl^ class_vars)) + interfaces (<>.else (list) + (<code>.tuple (<>.some (..super_class_decl^ class_vars)))) + annotations ..annotations^ + fields (<>.some (..field_decl^ class_vars)) + methods (<>.some (..method_def^ class_vars))]) + (do meta.monad + [current_module meta.current_module_name + .let [fully_qualified_class_name (format (safe current_module) "." full_class_name) + field_parsers (list#each (field_parser fully_qualified_class_name) fields) + method_parsers (list#each (method_parser (product.right class_decl) fully_qualified_class_name) methods) + replacer (parser_replacer (list#mix <>.either + (<>.failure "") + (list#composite field_parsers method_parsers))) + def_code (format "jvm class:" + (spaced (list (class_decl$ class_decl) + (super_class_decl$ super) + (with_brackets (spaced (list#each super_class_decl$ interfaces))) + (inheritance_modifier$ im) + (with_brackets (spaced (list#each annotation$ annotations))) + (with_brackets (spaced (list#each field_decl$ fields))) + (with_brackets (spaced (list#each (method_def$ replacer super) methods))))))]] + (in (list (` ((~ (code.text def_code))))))))) + +(def: .public interface: + (syntax (_ [class_decl ..class_decl^ + .let [class_vars (product.right class_decl)] + supers (<>.else (list) + (<code>.tuple (<>.some (..super_class_decl^ class_vars)))) + annotations ..annotations^ + members (<>.some (..method_decl^ class_vars))]) + (let [def_code (format "jvm interface:" + (spaced (list (class_decl$ class_decl) + (with_brackets (spaced (list#each super_class_decl$ supers))) + (with_brackets (spaced (list#each annotation$ annotations))) + (spaced (list#each method_decl$ members)))))] + (in (list (` ((~ (code.text def_code))))))))) + +(def: .public object + (syntax (_ [class_vars (<code>.tuple (<>.some ..type_param^)) + super (<>.else object_super_class + (..super_class_decl^ class_vars)) + interfaces (<>.else (list) + (<code>.tuple (<>.some (..super_class_decl^ class_vars)))) + constructor_args (..constructor_args^ class_vars) + methods (<>.some ..overriden_method_def^)]) + (let [def_code (format "jvm anon-class:" + (spaced (list (super_class_decl$ super) + (with_brackets (spaced (list#each super_class_decl$ interfaces))) + (with_brackets (spaced (list#each constructor_arg$ constructor_args))) + (with_brackets (spaced (list#each (method_def$ function.identity super) methods))))))] + (in (list (` ((~ (code.text def_code))))))))) + +(def: .public null + (syntax (_ []) + (in (list (` ("jvm object null")))))) (def: .public (null? obj) (-> (Primitive "java.lang.Object") Bit) ("jvm object null?" obj)) -(syntax: .public (??? [expr <code>.any]) - (with_symbols [g!temp] - (in (list (` (let [(~ g!temp) (~ expr)] - (if ("jvm object null?" (~ g!temp)) - {.#None} - {.#Some (~ g!temp)}))))))) - -(syntax: .public (!!! [expr <code>.any]) - (with_symbols [g!value] - (in (list (` (.case (~ expr) - {.#Some (~ g!value)} - (~ g!value) - - {.#None} - ("jvm object null"))))))) - -(syntax: .public (as [class (..generic_type^ (list)) - unchecked (<>.maybe <code>.any)]) - (with_symbols [g!_ g!unchecked] - (let [class_name (simple_class$ (list) class) - class_type (` (.Primitive (~ (code.text class_name)))) - check_type (` (.Maybe (~ class_type))) - check_code (` (if ((~ (code.text (format "jvm instanceof" ":" class_name))) (~ g!unchecked)) - {.#Some (.as (~ class_type) - (~ g!unchecked))} - {.#None}))] - (case unchecked - {.#Some unchecked} - (in (list (` (.is (~ check_type) - (let [(~ g!unchecked) (~ unchecked)] - (~ check_code)))))) +(def: .public ??? + (syntax (_ [expr <code>.any]) + (with_symbols [g!temp] + (in (list (` (let [(~ g!temp) (~ expr)] + (if ("jvm object null?" (~ g!temp)) + {.#None} + {.#Some (~ g!temp)})))))))) + +(def: .public !!! + (syntax (_ [expr <code>.any]) + (with_symbols [g!value] + (in (list (` (.case (~ expr) + {.#Some (~ g!value)} + (~ g!value) - {.#None} - (in (list (` (.is (-> (Primitive "java.lang.Object") (~ check_type)) - (function ((~ g!_) (~ g!unchecked)) - (~ check_code)))))) - )))) - -(syntax: .public (synchronized [lock <code>.any - body <code>.any]) - (in (list (` ("jvm object synchronized" (~ lock) (~ body)))))) - -(syntax: .public (do_to [obj <code>.any - methods (<>.some partial_call^)]) - (with_symbols [g!obj] - (in (list (` (let [(~ g!obj) (~ obj)] - (exec (~+ (list#each (complete_call$ g!obj) methods)) - (~ g!obj)))))))) + {.#None} + ("jvm object null")))))))) + +(def: .public as + (syntax (_ [class (..generic_type^ (list)) + unchecked (<>.maybe <code>.any)]) + (with_symbols [g!_ g!unchecked] + (let [class_name (simple_class$ (list) class) + class_type (` (.Primitive (~ (code.text class_name)))) + check_type (` (.Maybe (~ class_type))) + check_code (` (if ((~ (code.text (format "jvm instanceof" ":" class_name))) (~ g!unchecked)) + {.#Some (.as (~ class_type) + (~ g!unchecked))} + {.#None}))] + (case unchecked + {.#Some unchecked} + (in (list (` (.is (~ check_type) + (let [(~ g!unchecked) (~ unchecked)] + (~ check_code)))))) + + {.#None} + (in (list (` (.is (-> (Primitive "java.lang.Object") (~ check_type)) + (function ((~ g!_) (~ g!unchecked)) + (~ check_code)))))) + ))))) + +(def: .public synchronized + (syntax (_ [lock <code>.any + body <code>.any]) + (in (list (` ("jvm object synchronized" (~ lock) (~ body))))))) + +(def: .public do_to + (syntax (_ [obj <code>.any + methods (<>.some partial_call^)]) + (with_symbols [g!obj] + (in (list (` (let [(~ g!obj) (~ obj)] + (exec (~+ (list#each (complete_call$ g!obj) methods)) + (~ g!obj))))))))) (def: (class_import$ [full_name params]) (-> Class_Declaration Code) @@ -1486,8 +1495,9 @@ (decorate_return_maybe class member) (decorate_return_try member) (decorate_return_io member))]] - (in (list (` ((~! syntax:) ((~ def_name) [(~+ (syntax_inputs (list#each product.right arg_function_inputs)))]) - ((~' in) (.list (.` (~ jvm_interop))))))))) + (in (list (` (def: (~ def_name) + ((~! syntax) ((~ def_name) [(~+ (syntax_inputs (list#each product.right arg_function_inputs)))]) + ((~' in) (.list (.` (~ jvm_interop)))))))))) {#MethodDecl [commons method]} (with_symbols [g!obj] @@ -1519,9 +1529,10 @@ (decorate_return_maybe class member) (decorate_return_try member) (decorate_return_io member))]] - (in (list (` ((~! syntax:) ((~ def_name) [(~+ (syntax_inputs (list#each product.right arg_function_inputs))) - (~+ (syntax_inputs object_ast))]) - ((~' in) (.list (.` (~ jvm_interop)))))))))) + (in (list (` (def: (~ def_name) + ((~! syntax) ((~ def_name) [(~+ (syntax_inputs (list#each product.right arg_function_inputs))) + (~+ (syntax_inputs object_ast))]) + ((~' in) (.list (.` (~ jvm_interop))))))))))) {#FieldAccessDecl fad} (do meta.monad @@ -1554,8 +1565,9 @@ getter_body (if #import_field_setter? (` ((~! io.io) (~ getter_body))) getter_body)] - (in (` ((~! syntax:) (~ getter_call) - ((~' in) (.list (.` (~ getter_body))))))))) + (in (` (def: (~ getter_name) + ((~! syntax) (~ getter_call) + ((~' in) (.list (.` (~ getter_body)))))))))) setter_interop (.is (Meta (List Code)) (if #import_field_setter? (with_symbols [g!obj g!value] @@ -1574,8 +1586,9 @@ (if #import_field_static? (list) (list (un_quote g!obj))))] - (in (list (` ((~! syntax:) (~ setter_call) - ((~' in) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value)))))))))))) + (in (list (` (def: (~ setter_name) + ((~! syntax) (~ setter_call) + ((~' in) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value))))))))))))) (in (list))))] (in (partial_list getter_interop setter_interop))) ))) @@ -1611,36 +1624,39 @@ (meta.failure (format "Cannot load class: " class_name text.new_line error))))) -(syntax: .public (import [class_decl ..class_decl^ - import_format <code>.text - members (<>.some (..import_member_decl^ (product.right class_decl)))]) - (do [! meta.monad] - [kind (class_kind class_decl) - =members (|> members - (list#each (|>> [import_format])) - (monad.each ! (member_import$ (product.right class_decl) kind class_decl)))] - (in (partial_list (class_import$ class_decl) (list#conjoint =members))))) - -(syntax: .public (array [type (..generic_type^ (list)) - size <code>.any]) - (case type - (^.template [<type> <array_op>] - [(pattern {#GenericClass <type> (list)}) - (in (list (` (<array_op> (~ size)))))]) - (["boolean" "jvm znewarray"] - ["byte" "jvm bnewarray"] - ["short" "jvm snewarray"] - ["int" "jvm inewarray"] - ["long" "jvm lnewarray"] - ["float" "jvm fnewarray"] - ["double" "jvm dnewarray"] - ["char" "jvm cnewarray"]) +(def: .public import + (syntax (_ [class_decl ..class_decl^ + import_format <code>.text + members (<>.some (..import_member_decl^ (product.right class_decl)))]) + (do [! meta.monad] + [kind (class_kind class_decl) + =members (|> members + (list#each (|>> [import_format])) + (monad.each ! (member_import$ (product.right class_decl) kind class_decl)))] + (in (partial_list (class_import$ class_decl) (list#conjoint =members)))))) + +(def: .public array + (syntax (_ [type (..generic_type^ (list)) + size <code>.any]) + (case type + (^.template [<type> <array_op>] + [(pattern {#GenericClass <type> (list)}) + (in (list (` (<array_op> (~ size)))))]) + (["boolean" "jvm znewarray"] + ["byte" "jvm bnewarray"] + ["short" "jvm snewarray"] + ["int" "jvm inewarray"] + ["long" "jvm lnewarray"] + ["float" "jvm fnewarray"] + ["double" "jvm dnewarray"] + ["char" "jvm cnewarray"]) - _ - (in (list (` ("jvm anewarray" (~ (code.text (generic_type$ type))) (~ size))))))) + _ + (in (list (` ("jvm anewarray" (~ (code.text (generic_type$ type))) (~ size)))))))) -(syntax: .public (length [array <code>.any]) - (in (list (` ("jvm arraylength" (~ array)))))) +(def: .public length + (syntax (_ [array <code>.any]) + (in (list (` ("jvm arraylength" (~ array))))))) (def: (type_class_name type) (-> Type (Meta Text)) @@ -1664,68 +1680,72 @@ _ (meta.failure (format "Cannot convert to JvmType: " (type.format type)))))) -(syntax: .public (read! [idx <code>.any - array <code>.any]) - (case array - [_ {.#Symbol array_name}] - (do meta.monad - [array_type (meta.type array_name) - array_jvm_type (type_class_name array_type)] - (case array_jvm_type - (^.template [<type> <array_op>] - [<type> - (in (list (` (<array_op> (~ array) (~ idx)))))]) - (["[Z" "jvm zaload"] - ["[B" "jvm baload"] - ["[S" "jvm saload"] - ["[I" "jvm iaload"] - ["[J" "jvm jaload"] - ["[F" "jvm faload"] - ["[D" "jvm daload"] - ["[C" "jvm caload"]) - - _ - (in (list (` ("jvm aaload" (~ array) (~ idx))))))) +(def: .public read! + (syntax (_ [idx <code>.any + array <code>.any]) + (case array + [_ {.#Symbol array_name}] + (do meta.monad + [array_type (meta.type array_name) + array_jvm_type (type_class_name array_type)] + (case array_jvm_type + (^.template [<type> <array_op>] + [<type> + (in (list (` (<array_op> (~ array) (~ idx)))))]) + (["[Z" "jvm zaload"] + ["[B" "jvm baload"] + ["[S" "jvm saload"] + ["[I" "jvm iaload"] + ["[J" "jvm jaload"] + ["[F" "jvm faload"] + ["[D" "jvm daload"] + ["[C" "jvm caload"]) + + _ + (in (list (` ("jvm aaload" (~ array) (~ idx))))))) - _ - (with_symbols [g!array] - (in (list (` (let [(~ g!array) (~ array)] - (..read! (~ idx) (~ g!array))))))))) - -(syntax: .public (write! [idx <code>.any - value <code>.any - array <code>.any]) - (case array - [_ {.#Symbol array_name}] - (do meta.monad - [array_type (meta.type array_name) - array_jvm_type (type_class_name array_type)] - (case array_jvm_type - (^.template [<type> <array_op>] - [<type> - (in (list (` (<array_op> (~ array) (~ idx) (~ value)))))]) - (["[Z" "jvm zastore"] - ["[B" "jvm bastore"] - ["[S" "jvm sastore"] - ["[I" "jvm iastore"] - ["[J" "jvm jastore"] - ["[F" "jvm fastore"] - ["[D" "jvm dastore"] - ["[C" "jvm castore"]) - - _ - (in (list (` ("jvm aastore" (~ array) (~ idx) (~ value))))))) + _ + (with_symbols [g!array] + (in (list (` (let [(~ g!array) (~ array)] + (..read! (~ idx) (~ g!array)))))))))) + +(def: .public write! + (syntax (_ [idx <code>.any + value <code>.any + array <code>.any]) + (case array + [_ {.#Symbol array_name}] + (do meta.monad + [array_type (meta.type array_name) + array_jvm_type (type_class_name array_type)] + (case array_jvm_type + (^.template [<type> <array_op>] + [<type> + (in (list (` (<array_op> (~ array) (~ idx) (~ value)))))]) + (["[Z" "jvm zastore"] + ["[B" "jvm bastore"] + ["[S" "jvm sastore"] + ["[I" "jvm iastore"] + ["[J" "jvm jastore"] + ["[F" "jvm fastore"] + ["[D" "jvm dastore"] + ["[C" "jvm castore"]) + + _ + (in (list (` ("jvm aastore" (~ array) (~ idx) (~ value))))))) - _ - (with_symbols [g!array] - (in (list (` (let [(~ g!array) (~ array)] - (..write! (~ idx) (~ value) (~ g!array))))))))) + _ + (with_symbols [g!array] + (in (list (` (let [(~ g!array) (~ array)] + (..write! (~ idx) (~ value) (~ g!array)))))))))) -(syntax: .public (class_for [type (..generic_type^ (list))]) - (in (list (` ("jvm object class" (~ (code.text (simple_class$ (list) type)))))))) +(def: .public class_for + (syntax (_ [type (..generic_type^ (list))]) + (in (list (` ("jvm object class" (~ (code.text (simple_class$ (list) type))))))))) -(syntax: .public (type [type (..generic_type^ (list))]) - (in (list (..class_type {#ManualPrM} (list) type)))) +(def: .public type + (syntax (_ [type (..generic_type^ (list))]) + (in (list (..class_type {#ManualPrM} (list) type))))) (template: .public (is type term) [(.as type term)]) diff --git a/stdlib/source/library/lux/ffi.php.lux b/stdlib/source/library/lux/ffi.php.lux index b07186a02..a387237db 100644 --- a/stdlib/source/library/lux/ffi.php.lux +++ b/stdlib/source/library/lux/ffi.php.lux @@ -19,7 +19,7 @@ [type abstract] [macro (.only with_symbols) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code] ["[0]" template]]]]) @@ -186,14 +186,15 @@ ..constant )) -(syntax: .public (try [expression <code>.any]) - ... {.#doc (example (case (try (risky_computation input)) - ... {.#Right success} - ... (do_something success) +(def: .public try + (syntax (_ [expression <code>.any]) + ... {.#doc (example (case (try (risky_computation input)) + ... {.#Right success} + ... (do_something success) - ... {.#Left error} - ... (recover_from_failure error)))} - (in (list (` ("lux try" ((~! io.io) (~ expression))))))) + ... {.#Left error} + ... (recover_from_failure error)))} + (in (list (` ("lux try" ((~! io.io) (~ expression)))))))) (def: (with_io with? without) (-> Bit Code Code) @@ -236,83 +237,87 @@ (as ..Function (~ source)) (~+ (list#each (with_null g!temp) g!inputs))))))))))) -(syntax: .public (import [import ..import]) - (with_symbols [g!temp] - (case import - {#Class [class alias format members]} - (with_symbols [g!object] - (let [qualify (is (-> Text Code) - (function (_ member_name) - (|> format - (text.replaced "[1]" (maybe.else class alias)) - (text.replaced "[0]" member_name) - code.local))) - g!type (code.local (maybe.else class alias)) - class_import (` ("php constant" (~ (code.text class))))] - (in (partial_list (` (type: (~ g!type) - (..Object (Primitive (~ (code.text class)))))) - (list#each (function (_ member) - (case member - {#Field [static? field alias fieldT]} - (if static? - (` ((~! syntax:) ((~ (qualify (maybe.else field alias))) []) - (at (~! meta.monad) (~' in) - (list (` (.as (~ (nullable_type fieldT)) - ("php constant" (~ (code.text (%.format class "::" field)))))))))) - (` (def: ((~ (qualify field)) - (~ g!object)) - (-> (~ g!type) - (~ (nullable_type fieldT))) - (as_expected - (~ (without_null g!temp fieldT (` ("php object get" (~ (code.text field)) - (as (..Object .Any) (~ g!object)))))))))) - - {#Method method} - (case method - {#Static [method alias inputsT io? try? outputT]} - (..make_function (qualify (maybe.else method alias)) - g!temp - (` ("php object get" (~ (code.text method)) - (as (..Object .Any) - ("php constant" (~ (code.text (%.format class "::" method))))))) - inputsT - io? - try? - outputT) +(def: .public import + (syntax (_ [import ..import]) + (with_symbols [g!temp] + (case import + {#Class [class alias format members]} + (with_symbols [g!object] + (let [qualify (is (-> Text Code) + (function (_ member_name) + (|> format + (text.replaced "[1]" (maybe.else class alias)) + (text.replaced "[0]" member_name) + code.local))) + g!type (code.local (maybe.else class alias)) + class_import (` ("php constant" (~ (code.text class))))] + (in (partial_list (` (type: (~ g!type) + (..Object (Primitive (~ (code.text class)))))) + (list#each (function (_ member) + (case member + {#Field [static? field alias fieldT]} + (let [g!field (qualify (maybe.else field alias))] + (if static? + (` (def: (~ g!field) + ((~! syntax) ((~ g!field) []) + (at (~! meta.monad) (~' in) + (list (` (.as (~ (nullable_type fieldT)) + ("php constant" (~ (code.text (%.format class "::" field))))))))))) + (` (def: ((~ g!field) (~ g!object)) + (-> (~ g!type) + (~ (nullable_type fieldT))) + (as_expected + (~ (without_null g!temp fieldT (` ("php object get" (~ (code.text field)) + (as (..Object .Any) (~ g!object))))))))))) - {#Virtual [method alias inputsT io? try? outputT]} - (let [g!inputs (input_variables inputsT)] - (` (def: ((~ (qualify (maybe.else method alias))) - [(~+ (list#each product.right g!inputs))] - (~ g!object)) - (-> [(~+ (list#each nullable_type inputsT))] - (~ g!type) - (~ (|> (nullable_type outputT) - (try_type try?) - (io_type io?)))) - (as_expected - (~ (<| (with_io io?) - (with_try try?) - (without_null g!temp outputT) - (` ("php object do" - (~ (code.text method)) - (~ g!object) - (~+ (list#each (with_null g!temp) g!inputs))))))))))))) - members))))) - - {#Function [name alias inputsT io? try? outputT]} - (let [imported (` ("php constant" (~ (code.text name))))] - (in (list (..make_function (code.local (maybe.else name alias)) - g!temp - imported - inputsT - io? - try? - outputT)))) - - {#Constant [_ name alias fieldT]} - (let [imported (` ("php constant" (~ (code.text name))))] - (in (list (` ((~! syntax:) ((~ (code.local (maybe.else name alias))) []) - (at (~! meta.monad) (~' in) - (list (` (.as (~ (nullable_type fieldT)) (~ imported)))))))))) - ))) + {#Method method} + (case method + {#Static [method alias inputsT io? try? outputT]} + (..make_function (qualify (maybe.else method alias)) + g!temp + (` ("php object get" (~ (code.text method)) + (as (..Object .Any) + ("php constant" (~ (code.text (%.format class "::" method))))))) + inputsT + io? + try? + outputT) + + {#Virtual [method alias inputsT io? try? outputT]} + (let [g!inputs (input_variables inputsT)] + (` (def: ((~ (qualify (maybe.else method alias))) + [(~+ (list#each product.right g!inputs))] + (~ g!object)) + (-> [(~+ (list#each nullable_type inputsT))] + (~ g!type) + (~ (|> (nullable_type outputT) + (try_type try?) + (io_type io?)))) + (as_expected + (~ (<| (with_io io?) + (with_try try?) + (without_null g!temp outputT) + (` ("php object do" + (~ (code.text method)) + (~ g!object) + (~+ (list#each (with_null g!temp) g!inputs))))))))))))) + members))))) + + {#Function [name alias inputsT io? try? outputT]} + (let [imported (` ("php constant" (~ (code.text name))))] + (in (list (..make_function (code.local (maybe.else name alias)) + g!temp + imported + inputsT + io? + try? + outputT)))) + + {#Constant [_ name alias fieldT]} + (let [imported (` ("php constant" (~ (code.text name)))) + g!name (code.local (maybe.else name alias))] + (in (list (` (def: (~ g!name) + ((~! syntax) ((~ g!name) []) + (at (~! meta.monad) (~' in) + (list (` (.as (~ (nullable_type fieldT)) (~ imported))))))))))) + )))) diff --git a/stdlib/source/library/lux/ffi.scm.lux b/stdlib/source/library/lux/ffi.scm.lux index fc6107571..8822efd3d 100644 --- a/stdlib/source/library/lux/ffi.scm.lux +++ b/stdlib/source/library/lux/ffi.scm.lux @@ -19,7 +19,7 @@ [type abstract] [macro (.only with_symbols) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code] ["[0]" template]]]]) @@ -151,14 +151,15 @@ ..constant )) -(syntax: .public (try [expression <code>.any]) - ... {.#doc (example (case (try (risky_computation input)) - ... {.#Right success} - ... (do_something success) +(def: .public try + (syntax (_ [expression <code>.any]) + ... {.#doc (example (case (try (risky_computation input)) + ... {.#Right success} + ... (do_something success) - ... {.#Left error} - ... (recover_from_failure error)))} - (in (list (` ("lux try" ((~! io.io) (~ expression))))))) + ... {.#Left error} + ... (recover_from_failure error)))} + (in (list (` ("lux try" ((~! io.io) (~ expression)))))))) (def: (with_io with? without) (-> Bit Code Code) @@ -201,22 +202,25 @@ (as ..Function (~ source)) (~+ (list#each (with_nil g!temp) g!inputs))))))))))) -(syntax: .public (import [import ..import]) - (with_symbols [g!temp] - (case import - {#Function [name alias inputsT io? try? outputT]} - (let [imported (` ("scheme constant" (~ (code.text name))))] - (in (list (..make_function (code.local (maybe.else name alias)) - g!temp - imported - inputsT - io? - try? - outputT)))) - - {#Constant [_ name alias fieldT]} - (let [imported (` ("scheme constant" (~ (code.text name))))] - (in (list (` ((~! syntax:) ((~ (code.local (maybe.else name alias)))) - (at (~! meta.monad) (~' in) - (list (` (.as (~ (nilable_type fieldT)) (~ imported)))))))))) - ))) +(def: .public import + (syntax (_ [import ..import]) + (with_symbols [g!temp] + (case import + {#Function [name alias inputsT io? try? outputT]} + (let [imported (` ("scheme constant" (~ (code.text name))))] + (in (list (..make_function (code.local (maybe.else name alias)) + g!temp + imported + inputsT + io? + try? + outputT)))) + + {#Constant [_ name alias fieldT]} + (let [imported (` ("scheme constant" (~ (code.text name)))) + g!name (code.local (maybe.else name alias))] + (in (list (` (def: (~ g!name) + ((~! syntax) ((~ g!name) []) + (at (~! meta.monad) (~' in) + (list (` (.as (~ (nilable_type fieldT)) (~ imported))))))))))) + )))) diff --git a/stdlib/source/library/lux/ffi/export.js.lux b/stdlib/source/library/lux/ffi/export.js.lux index 9cf794d8e..07f3e8268 100644 --- a/stdlib/source/library/lux/ffi/export.js.lux +++ b/stdlib/source/library/lux/ffi/export.js.lux @@ -16,7 +16,7 @@ ["[0]" list (.open: "[1]#[0]" monad mix)] ["[0]" set]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math ["[0]" random]] @@ -85,12 +85,13 @@ (generation.log! (%.format "Export " (%.text name)))))] (in directive.no_requirements))) - (syntax: .public (export: [exports (<>.many <code>.any)]) - (let [! meta.monad] - (|> exports - (monad.each ! macro.expansion) - (at ! each (|>> list#conjoint - (monad.each ! ..definition))) - (at ! conjoint) - (at ! each (list#each (function (_ [name term]) - (` (<extension> (~ (code.text name)) (~ term)))))))))) + (def: .public export + (syntax (_ [exports (<>.many <code>.any)]) + (let [! meta.monad] + (|> exports + (monad.each ! macro.expansion) + (at ! each (|>> list#conjoint + (monad.each ! ..definition))) + (at ! conjoint) + (at ! each (list#each (function (_ [name term]) + (` (<extension> (~ (code.text name)) (~ term))))))))))) diff --git a/stdlib/source/library/lux/ffi/export.jvm.lux b/stdlib/source/library/lux/ffi/export.jvm.lux index fea7a2239..163c98285 100644 --- a/stdlib/source/library/lux/ffi/export.jvm.lux +++ b/stdlib/source/library/lux/ffi/export.jvm.lux @@ -8,7 +8,7 @@ [collection ["[0]" list (.open: "[1]#[0]" monad)]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]]]] ["[0]" //]) @@ -57,50 +57,51 @@ {#Constant (API Constant)} {#Function (API Function)})) -(def: export +(def: exportP (Parser Export) (all <>.or (..api ..constant) (..api ..function) )) -(syntax: .public (export: [api <code>.local - exports (<>.many ..export)]) - (let [initialization (is (List (API Constant)) - (list.all (.function (_ it) - (case it - {#Constant it} - {.#Some it} - - _ - {.#None})) - exports))] - (in (list (` (//.class: "final" (~ (code.local api)) - (~+ (list#each (.function (_ it) - (case it - {#Constant [name type term]} - (` ("public" "final" "static" (~ (code.local name)) (~ type))) - - {#Function [[variables name requirements] type term]} - (` ("public" "strict" "static" - [(~+ (list#each code.local variables))] - ((~ (code.local name)) - [(~+ (|> requirements - (list#each (.function (_ [name type]) - (list (code.local name) - type))) - list#conjoint))]) - (~ type) - (~ term))))) - exports)) - ... Useless constructor - ("private" [] ((~' new) (~' self) []) [] []) - ("public" "strict" "static" [] ((~' <clinit>) []) - (~' void) - [(~+ (list#each (.function (_ [name type term]) - (` ("jvm member put static" - (~ (code.text api)) - (~ (code.text name)) - ("jvm object cast" (~ term))))) - initialization))]) - )))))) +(def: .public export + (syntax (_ [api <code>.local + exports (<>.many ..exportP)]) + (let [initialization (is (List (API Constant)) + (list.all (.function (_ it) + (case it + {#Constant it} + {.#Some it} + + _ + {.#None})) + exports))] + (in (list (` (//.class: "final" (~ (code.local api)) + (~+ (list#each (.function (_ it) + (case it + {#Constant [name type term]} + (` ("public" "final" "static" (~ (code.local name)) (~ type))) + + {#Function [[variables name requirements] type term]} + (` ("public" "strict" "static" + [(~+ (list#each code.local variables))] + ((~ (code.local name)) + [(~+ (|> requirements + (list#each (.function (_ [name type]) + (list (code.local name) + type))) + list#conjoint))]) + (~ type) + (~ term))))) + exports)) + ... Useless constructor + ("private" [] ((~' new) (~' self) []) [] []) + ("public" "strict" "static" [] ((~' <clinit>) []) + (~' void) + [(~+ (list#each (.function (_ [name type term]) + (` ("jvm member put static" + (~ (code.text api)) + (~ (code.text name)) + ("jvm object cast" (~ term))))) + initialization))]) + ))))))) diff --git a/stdlib/source/library/lux/ffi/export.lua.lux b/stdlib/source/library/lux/ffi/export.lua.lux index 60f5d24d3..8bc85319c 100644 --- a/stdlib/source/library/lux/ffi/export.lua.lux +++ b/stdlib/source/library/lux/ffi/export.lua.lux @@ -16,7 +16,7 @@ ["[0]" list (.open: "[1]#[0]" monad mix)] ["[0]" set]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math ["[0]" random]] @@ -101,12 +101,13 @@ (generation.log! (%.format "Export " (%.text name)))))] (in directive.no_requirements))) - (syntax: .public (export: [exports (<>.many <code>.any)]) - (let [! meta.monad] - (|> exports - (monad.each ! macro.expansion) - (at ! each (|>> list#conjoint - (monad.each ! ..definition))) - (at ! conjoint) - (at ! each (list#each (function (_ [name term]) - (` (<extension> (~ (code.text name)) (~ term)))))))))) + (def: .public export + (syntax (_ [exports (<>.many <code>.any)]) + (let [! meta.monad] + (|> exports + (monad.each ! macro.expansion) + (at ! each (|>> list#conjoint + (monad.each ! ..definition))) + (at ! conjoint) + (at ! each (list#each (function (_ [name term]) + (` (<extension> (~ (code.text name)) (~ term))))))))))) diff --git a/stdlib/source/library/lux/ffi/export.py.lux b/stdlib/source/library/lux/ffi/export.py.lux index 40a5be6b7..87475b5df 100644 --- a/stdlib/source/library/lux/ffi/export.py.lux +++ b/stdlib/source/library/lux/ffi/export.py.lux @@ -16,7 +16,7 @@ ["[0]" list (.open: "[1]#[0]" monad mix)] ["[0]" set]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math ["[0]" random]] @@ -78,12 +78,13 @@ (generation.log! (%.format "Export " (%.text name)))))] (in directive.no_requirements))) - (syntax: .public (export: [exports (<>.many <code>.any)]) - (let [! meta.monad] - (|> exports - (monad.each ! macro.expansion) - (at ! each (|>> list#conjoint - (monad.each ! ..definition))) - (at ! conjoint) - (at ! each (list#each (function (_ [name term]) - (` (<extension> (~ (code.text name)) (~ term)))))))))) + (def: .public export + (syntax (_ [exports (<>.many <code>.any)]) + (let [! meta.monad] + (|> exports + (monad.each ! macro.expansion) + (at ! each (|>> list#conjoint + (monad.each ! ..definition))) + (at ! conjoint) + (at ! each (list#each (function (_ [name term]) + (` (<extension> (~ (code.text name)) (~ term))))))))))) diff --git a/stdlib/source/library/lux/ffi/export.rb.lux b/stdlib/source/library/lux/ffi/export.rb.lux index 16dd315a9..e8cbc6f8b 100644 --- a/stdlib/source/library/lux/ffi/export.rb.lux +++ b/stdlib/source/library/lux/ffi/export.rb.lux @@ -18,7 +18,7 @@ ["[0]" list (.open: "[1]#[0]" monad mix)] ["[0]" set]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math ["[0]" random]] @@ -127,18 +127,19 @@ (generation.log! (%.format "Export " (%.text name)))))] (in directive.no_requirements))) - (syntax: .public (export: [exports (<>.many <code>.any)]) - (let [! meta.monad] - (|> exports - (monad.each ! macro.expansion) - (at ! each (|>> list#conjoint - (monad.each ! ..definition))) - (at ! conjoint) - (at ! each (list#each (function (_ [name term]) - (` (<extension> (~+ (case name - {#Method name} - (list (code.bit #0) (code.text name)) - - {#Global name} - (list (code.bit #1) (code.text name)))) - (~ term)))))))))) + (def: .public export + (syntax (_ [exports (<>.many <code>.any)]) + (let [! meta.monad] + (|> exports + (monad.each ! macro.expansion) + (at ! each (|>> list#conjoint + (monad.each ! ..definition))) + (at ! conjoint) + (at ! each (list#each (function (_ [name term]) + (` (<extension> (~+ (case name + {#Method name} + (list (code.bit #0) (code.text name)) + + {#Global name} + (list (code.bit #1) (code.text name)))) + (~ term))))))))))) diff --git a/stdlib/source/library/lux/macro/syntax.lux b/stdlib/source/library/lux/macro/syntax.lux index d8f289bd6..a510cb759 100644 --- a/stdlib/source/library/lux/macro/syntax.lux +++ b/stdlib/source/library/lux/macro/syntax.lux @@ -42,20 +42,19 @@ {.#End} {.#End} {.#Item [[x y] pairs']} (partial_list x y (un_paired pairs')))) -(def: syntax - (Parser [Code [Text (Maybe Text) (List Code)] Code]) - (/export.parser - (all <>.and - (</>.form (all <>.and - </>.local - (<>.maybe </>.local) - (</>.tuple (<>.some </>.any)))) - </>.any))) +(def: syntaxP + (Parser [[Text (Maybe Text) (List Code)] Code]) + (all <>.and + (</>.form (all <>.and + </>.local + (<>.maybe </>.local) + (</>.tuple (<>.some </>.any)))) + </>.any)) -(def: .public syntax: +(def: .public syntax (macro (_ tokens) - (case (</>.result ..syntax tokens) - {try.#Success [export_policy [name g!state args] body]} + (case (</>.result ..syntaxP tokens) + {try.#Success [[name g!state args] body]} (with_symbols [g!tokens g!body g!error] (do [! meta.monad] [vars+parsers (case (list.pairs args) @@ -88,19 +87,18 @@ this_module meta.current_module_name .let [error_msg (code.text (//.wrong_syntax_error [this_module name])) g!name (code.symbol ["" name])]] - (in (list (` (.def: (~ export_policy) (~ g!name) - (.macro ((~ g!name) (~ g!tokens) (~ g!state)) - (.case ((~! </>.result) - (is ((~! </>.Parser) (Meta (List Code))) - ((~! do) (~! <>.monad) - [(~+ (..un_paired vars+parsers))] - ((~' in) (~ body)))) - (~ g!tokens)) - {try.#Success (~ g!body)} - ((~ g!body) (~ g!state)) + (in (list (` (.macro ((~ g!name) (~ g!tokens) (~ g!state)) + (.case ((~! </>.result) + (is ((~! </>.Parser) (Meta (List Code))) + ((~! do) (~! <>.monad) + [(~+ (..un_paired vars+parsers))] + (.at (~! <>.monad) (~' in) (~ body)))) + (~ g!tokens)) + {try.#Success (~ g!body)} + ((~ g!body) (~ g!state)) - {try.#Failure (~ g!error)} - {try.#Failure ((~! text.interposed) (~! text.new_line) (list (~ error_msg) (~ g!error)))})))))))) + {try.#Failure (~ g!error)} + {try.#Failure ((~! text.interposed) (~! text.new_line) (list (~ error_msg) (~ g!error)))}))))))) {try.#Failure error} - (meta.failure (//.wrong_syntax_error (symbol ..syntax:)))))) + (meta.failure (//.wrong_syntax_error (symbol ..syntax)))))) diff --git a/stdlib/source/library/lux/macro/template.lux b/stdlib/source/library/lux/macro/template.lux index 7bbc17e84..cec732f01 100644 --- a/stdlib/source/library/lux/macro/template.lux +++ b/stdlib/source/library/lux/macro/template.lux @@ -24,27 +24,30 @@ ["[0]" rev (.open: "[1]#[0]" decimal)] ["[0]" frac (.open: "[1]#[0]" decimal)]]]]] ["[0]" // (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code] ["[0]" local]]) -(syntax: .public (spliced [parts (<code>.tuple (<>.some <code>.any))]) - (in parts)) - -(syntax: .public (amount [parts (<code>.tuple (<>.some <code>.any))]) - (in (list (code.nat (list.size parts))))) - -(syntax: .public (with_locals [locals (<code>.tuple (<>.some <code>.local)) - body <code>.any]) - (do [! meta.monad] - [g!locals (|> locals - (list#each //.symbol) - (monad.all !))] - (in (list (` (.with_expansions [(~+ (|> (list.zipped_2 locals g!locals) - (list#each (function (_ [name symbol]) - (list (code.local name) symbol))) - list#conjoint))] - (~ body))))))) +(def: .public spliced + (syntax (_ [parts (<code>.tuple (<>.some <code>.any))]) + (in parts))) + +(def: .public amount + (syntax (_ [parts (<code>.tuple (<>.some <code>.any))]) + (in (list (code.nat (list.size parts)))))) + +(def: .public with_locals + (syntax (_ [locals (<code>.tuple (<>.some <code>.local)) + body <code>.any]) + (do [! meta.monad] + [g!locals (|> locals + (list#each //.symbol) + (monad.all !))] + (in (list (` (.with_expansions [(~+ (|> (list.zipped_2 locals g!locals) + (list#each (function (_ [name symbol]) + (list (code.local name) symbol))) + list#conjoint))] + (~ body)))))))) (def: (symbol_side module_side? parser) (-> Bit (Parser Symbol) (Parser Text)) @@ -76,19 +79,21 @@ (-> Bit (Parser (List Text))) (<code>.tuple (<>.many (..snippet module_side?)))) -(syntax: .public (text [simple (..part false)]) - (in (list (|> simple (text.interposed "") code.text)))) +(def: .public text + (syntax (_ [simple (..part false)]) + (in (list (|> simple (text.interposed "") code.text))))) (template [<name> <simple> <complex>] - [(syntax: .public (<name> [name (<>.or (<>.and (..part true) (..part false)) - (..part false))]) - (case name - {.#Left [simple complex]} - (in (list (<complex> [(text.interposed "" simple) - (text.interposed "" complex)]))) - - {.#Right simple} - (in (list (|> simple (text.interposed "") <simple>)))))] + [(def: .public <name> + (syntax (_ [name (<>.or (<>.and (..part true) (..part false)) + (..part false))]) + (case name + {.#Left [simple complex]} + (in (list (<complex> [(text.interposed "" simple) + (text.interposed "" complex)]))) + + {.#Right simple} + (in (list (|> simple (text.interposed "") <simple>))))))] [symbol code.local code.symbol] ) @@ -152,26 +157,27 @@ #parameters parameters #template template]))) -(syntax: .public (let [locals (<code>.tuple (<>.some ..local)) - body <code>.any]) - (do meta.monad - [here_name meta.current_module_name - expression? (is (Meta Bit) - (function (_ lux) - {try.#Success [lux (case (the .#expected lux) - {.#None} - false - - {.#Some _} - true)]})) - g!pop (local.push (list#each (function (_ local) - [[here_name (the #name local)] - (..macro local)]) - locals))] - (if expression? - (//.with_symbols [g!body] - (in (list (` (.let [(~ g!body) (~ body)] - (exec (~ g!pop) - (~ g!body))))))) - (in (list body - g!pop))))) +(def: .public let + (syntax (_ [locals (<code>.tuple (<>.some ..local)) + body <code>.any]) + (do meta.monad + [here_name meta.current_module_name + expression? (is (Meta Bit) + (function (_ lux) + {try.#Success [lux (case (the .#expected lux) + {.#None} + false + + {.#Some _} + true)]})) + g!pop (local.push (list#each (function (_ local) + [[here_name (the #name local)] + (..macro local)]) + locals))] + (if expression? + (//.with_symbols [g!body] + (in (list (` (.let [(~ g!body) (~ body)] + (exec (~ g!pop) + (~ g!body))))))) + (in (list body + g!pop)))))) diff --git a/stdlib/source/library/lux/math.lux b/stdlib/source/library/lux/math.lux index 0a32f20b8..9a53b8f0e 100644 --- a/stdlib/source/library/lux/math.lux +++ b/stdlib/source/library/lux/math.lux @@ -17,7 +17,7 @@ [collection ["[0]" list (.open: "[1]#[0]" mix)]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" template]] [tool [compiler @@ -109,8 +109,9 @@ ... else (phase.except ..no_arithmetic_for [:it:]))))))) - (syntax: .public (<name> [operands (<>.some <code>.any)]) - (in (list (` (<extension> (~+ operands))))))))] + (def: .public <name> + (syntax (_ [operands (<>.some <code>.any)]) + (in (list (` (<extension> (~+ operands)))))))))] [+ [[.Nat (in (analysis.nat 0)) "lux i64 +"] [.Int (in (analysis.int +0)) "lux i64 +"] @@ -161,9 +162,10 @@ ... else (phase.except ..no_arithmetic_for [:it:])))))) - (syntax: .public (<name> [left <code>.any - right <code>.any]) - (in (list (` (<extension> (~ left) (~ right))))))))] + (def: .public <name> + (syntax (_ [left <code>.any + right <code>.any]) + (in (list (` (<extension> (~ left) (~ right)))))))))] [= [[.Nat "lux i64 ="] [.Int "lux i64 ="] @@ -216,9 +218,10 @@ ... else (phase.except ..no_arithmetic_for [:it:])))))) - (syntax: .public (<name> [left <code>.any - right <code>.any]) - (in (list (` (<extension> (~ left) (~ right))))))))] + (def: .public <name> + (syntax (_ [left <code>.any + right <code>.any]) + (in (list (` (<extension> (~ left) (~ right)))))))))] [% [[.Nat nat.%] [.Int "lux i64 %"] diff --git a/stdlib/source/library/lux/math/infix.lux b/stdlib/source/library/lux/math/infix.lux index 8a37aa0f7..bb3039035 100644 --- a/stdlib/source/library/lux/math/infix.lux +++ b/stdlib/source/library/lux/math/infix.lux @@ -11,7 +11,7 @@ [collection ["[0]" list (.open: "[1]#[0]" mix)]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math [number @@ -70,5 +70,6 @@ {#Binary left op right} (` ((~ op) (~ (prefix right)) (~ (prefix left)))))) -(syntax: .public (infix [expr ..expression]) - (in (list (..prefix expr)))) +(def: .public infix + (syntax (_ [expr ..expression]) + (in (list (..prefix expr))))) diff --git a/stdlib/source/library/lux/math/modular.lux b/stdlib/source/library/lux/math/modular.lux index 77f611732..1af638ee7 100644 --- a/stdlib/source/library/lux/math/modular.lux +++ b/stdlib/source/library/lux/math/modular.lux @@ -17,7 +17,6 @@ ["[0]" product] ["[0]" text (.open: "[1]#[0]" monoid)]] [macro - [syntax (.only syntax:)] ["[0]" code]] [math [number diff --git a/stdlib/source/library/lux/math/modulus.lux b/stdlib/source/library/lux/math/modulus.lux index 423e32d68..43d341214 100644 --- a/stdlib/source/library/lux/math/modulus.lux +++ b/stdlib/source/library/lux/math/modulus.lux @@ -10,7 +10,7 @@ [parser ["<[0]>" code]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math [number @@ -46,8 +46,9 @@ (i.= +0))) ) -(syntax: .public (literal [divisor <code>.int]) - (meta.lifted - (do try.monad - [_ (..modulus divisor)] - (in (list (` ((~! try.trusted) (..modulus (~ (code.int divisor)))))))))) +(def: .public literal + (syntax (_ [divisor <code>.int]) + (meta.lifted + (do try.monad + [_ (..modulus divisor)] + (in (list (` ((~! try.trusted) (..modulus (~ (code.int divisor))))))))))) diff --git a/stdlib/source/library/lux/math/number/complex.lux b/stdlib/source/library/lux/math/number/complex.lux index 5e320c560..2965f2c12 100644 --- a/stdlib/source/library/lux/math/number/complex.lux +++ b/stdlib/source/library/lux/math/number/complex.lux @@ -11,7 +11,7 @@ [collection ["[0]" list (.open: "[1]#[0]" functor)]]] [macro - [syntax (.only syntax:)]] + [syntax (.only syntax)]] [math [number ["f" frac] @@ -22,10 +22,11 @@ [#real Frac #imaginary Frac])) -(syntax: .public (complex [real <code>.any - ?imaginary (<>.maybe <code>.any)]) - (in (list (` [..#real (~ real) - ..#imaginary (~ (maybe.else (' +0.0) ?imaginary))])))) +(def: .public complex + (syntax (_ [real <code>.any + ?imaginary (<>.maybe <code>.any)]) + (in (list (` [..#real (~ real) + ..#imaginary (~ (maybe.else (' +0.0) ?imaginary))]))))) (def: .public i Complex diff --git a/stdlib/source/library/lux/math/number/ratio.lux b/stdlib/source/library/lux/math/number/ratio.lux index a7c1c4762..50ba795b2 100644 --- a/stdlib/source/library/lux/math/number/ratio.lux +++ b/stdlib/source/library/lux/math/number/ratio.lux @@ -17,7 +17,7 @@ ["[0]" product] ["[0]" text (.open: "[1]#[0]" monoid)]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]]]] [// ["n" nat (.open: "[1]#[0]" decimal)]]) @@ -39,10 +39,11 @@ [..#numerator (n./ common _#numerator) ..#denominator (n./ common _#denominator)])) -(syntax: .public (ratio [numerator <code>.any - ?denominator (<>.maybe <code>.any)]) - (in (list (` ((~! ..normal) [..#numerator (~ numerator) - ..#denominator (~ (maybe.else (' 1) ?denominator))]))))) +(def: .public ratio + (syntax (_ [numerator <code>.any + ?denominator (<>.maybe <code>.any)]) + (in (list (` ((~! ..normal) [..#numerator (~ numerator) + ..#denominator (~ (maybe.else (' 1) ?denominator))])))))) (def: .public (= parameter subject) (-> Ratio Ratio Bit) diff --git a/stdlib/source/library/lux/meta/configuration.lux b/stdlib/source/library/lux/meta/configuration.lux index be16a5110..18464b10c 100644 --- a/stdlib/source/library/lux/meta/configuration.lux +++ b/stdlib/source/library/lux/meta/configuration.lux @@ -20,7 +20,7 @@ [dictionary ["/" plist]]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math [number (.only hex)]]]]) @@ -86,18 +86,19 @@ (maybe.else false)) (subsumes? expected tail)))) -(syntax: .public (for [specializations (<>.some (<>.and ..configuration <code>.any)) - default (<>.maybe <code>.any)]) - (do meta.monad - [actual meta.configuration] - (case (list#mix (function (_ [expected then] choice) - (if (subsumes? actual expected) - {.#Some then} - choice)) - default - specializations) - {.#Some it} - (in (list it)) - - {.#None} - (meta.failure (exception.error ..invalid []))))) +(def: .public for + (syntax (_ [specializations (<>.some (<>.and ..configuration <code>.any)) + default (<>.maybe <code>.any)]) + (do meta.monad + [actual meta.configuration] + (case (list#mix (function (_ [expected then] choice) + (if (subsumes? actual expected) + {.#Some then} + choice)) + default + specializations) + {.#Some it} + (in (list it)) + + {.#None} + (meta.failure (exception.error ..invalid [])))))) diff --git a/stdlib/source/library/lux/meta/version.lux b/stdlib/source/library/lux/meta/version.lux index 47bc430b4..4fc4b2409 100644 --- a/stdlib/source/library/lux/meta/version.lux +++ b/stdlib/source/library/lux/meta/version.lux @@ -13,7 +13,7 @@ [collection ["[0]" list (.open: "[1]#[0]" mix)]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [tool [compiler @@ -23,25 +23,27 @@ Version 00,07,00) -(syntax: .public (current []) - (do meta.monad - [it meta.version] - (in (list (code.text it))))) +(def: .public current + (syntax (_ []) + (do meta.monad + [it meta.version] + (in (list (code.text it)))))) (exception: .public invalid) -(syntax: .public (for [specializations (<>.some (<>.and <code>.text <code>.any)) - default (<>.maybe <code>.any)]) - (do meta.monad - [current meta.version] - (case (list#mix (function (_ [when then] choice) - (if (text#= when current) - {.#Some then} - choice)) - default - specializations) - {.#Some it} - (in (list it)) - - {.#None} - (meta.failure (exception.error ..invalid []))))) +(def: .public for + (syntax (_ [specializations (<>.some (<>.and <code>.text <code>.any)) + default (<>.maybe <code>.any)]) + (do meta.monad + [current meta.version] + (case (list#mix (function (_ [when then] choice) + (if (text#= when current) + {.#Some then} + choice)) + default + specializations) + {.#Some it} + (in (list it)) + + {.#None} + (meta.failure (exception.error ..invalid [])))))) diff --git a/stdlib/source/library/lux/program.lux b/stdlib/source/library/lux/program.lux index 0af2729ce..8fabbe9c7 100644 --- a/stdlib/source/library/lux/program.lux +++ b/stdlib/source/library/lux/program.lux @@ -12,7 +12,7 @@ ["<[0]>" code] ["<[0]>" cli]]] [macro (.only with_symbols) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]]]]) (type: Arguments @@ -25,33 +25,34 @@ (<>.or <code>.local (<code>.tuple (<>.some <code>.any)))) -(syntax: .public (program: [args ..arguments^ - body <code>.any]) - (with_symbols [g!program g!args g!_ g!output g!message] - (let [initialization+event_loop (for @.old body - @.jvm body - @.js body - @.python body - (` ((~! do) (~! io.monad) - [(~ g!output) (~ body) - (~ g!_) (~! thread.run!)] - ((~' in) (~ g!output)))))] - (in (list (` ("lux def program" - (~ (case args - {#Raw args} - (` (.function ((~ g!program) (~ (code.symbol ["" args]))) - (~ initialization+event_loop))) - - {#Parsed args} - (` (.function ((~ g!program) (~ g!args)) - (case ((~! <cli>.result) (.is (~! (<cli>.Parser (io.IO .Any))) - ((~! do) (~! <>.monad) - [(~+ args) - (~ g!_) (~! <cli>.end)] - ((~' in) (~ initialization+event_loop)))) - (~ g!args)) - {.#Right (~ g!output)} - (~ g!output) +(def: .public program: + (syntax (_ [args ..arguments^ + body <code>.any]) + (with_symbols [g!program g!args g!_ g!output g!message] + (let [initialization+event_loop (for @.old body + @.jvm body + @.js body + @.python body + (` ((~! do) (~! io.monad) + [(~ g!output) (~ body) + (~ g!_) (~! thread.run!)] + ((~' in) (~ g!output)))))] + (in (list (` ("lux def program" + (~ (case args + {#Raw args} + (` (.function ((~ g!program) (~ (code.symbol ["" args]))) + (~ initialization+event_loop))) + + {#Parsed args} + (` (.function ((~ g!program) (~ g!args)) + (case ((~! <cli>.result) (.is (~! (<cli>.Parser (io.IO .Any))) + ((~! do) (~! <>.monad) + [(~+ args) + (~ g!_) (~! <cli>.end)] + ((~' in) (~ initialization+event_loop)))) + (~ g!args)) + {.#Right (~ g!output)} + (~ g!output) - {.#Left (~ g!message)} - (.panic! (~ g!message)))))))))))))) + {.#Left (~ g!message)} + (.panic! (~ g!message))))))))))))))) diff --git a/stdlib/source/library/lux/static.lux b/stdlib/source/library/lux/static.lux index 590776b04..21f749b1c 100644 --- a/stdlib/source/library/lux/static.lux +++ b/stdlib/source/library/lux/static.lux @@ -11,17 +11,18 @@ [collection ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math [number (.only hex)] ["[0]" random (.only Random)]]]]) (template [<name> <type> <format>] - [(syntax: .public (<name> [expression <code>.any]) - (at meta.monad each - (|>> (as <type>) <format> list) - (meta.eval <type> expression)))] + [(def: .public <name> + (syntax (_ [expression <code>.any]) + (at meta.monad each + (|>> (as <type>) <format> list) + (meta.eval <type> expression))))] [bit .Bit code.bit] [nat .Nat code.nat] @@ -38,35 +39,39 @@ (with_expansions [<type> (Ex (_ a) [(-> a Code) a])] - (syntax: .public (literal [format <code>.any - expression <code>.any]) - (do meta.monad - [pair (meta.eval (.type <type>) - (` [(~ format) (~ expression)])) - .let [[format expression] (as <type> pair)]] - (in (list (format expression)))))) + (def: .public literal + (syntax (_ [format <code>.any + expression <code>.any]) + (do meta.monad + [pair (meta.eval (.type <type>) + (` [(~ format) (~ expression)])) + .let [[format expression] (as <type> pair)]] + (in (list (format expression))))))) (with_expansions [<type> (Ex (_ a) [(-> a Code) (List a)])] - (syntax: .public (literals [format <code>.any - expression <code>.any]) - (do meta.monad - [pair (meta.eval (.type <type>) - (` [(~ format) (~ expression)])) - .let [[format expression] (as <type> pair)]] - (in (list#each format expression))))) + (def: .public literals + (syntax (_ [format <code>.any + expression <code>.any]) + (do meta.monad + [pair (meta.eval (.type <type>) + (` [(~ format) (~ expression)])) + .let [[format expression] (as <type> pair)]] + (in (list#each format expression)))))) -(syntax: .public (seed []) - (meta#each (|>> code.nat list) meta.seed)) +(def: .public seed + (syntax (_ []) + (meta#each (|>> code.nat list) meta.seed))) (template [<name> <random> <format>] - [(syntax: .public (<name> []) - (do meta.monad - [seed meta.seed - .let [[_ result] (random.result (random.pcg_32 [..pcg_32_magic_inc seed]) - <random>)]] - (in (list (<format> result)))))] + [(def: .public <name> + (syntax (_ []) + (do meta.monad + [seed meta.seed + .let [[_ result] (random.result (random.pcg_32 [..pcg_32_magic_inc seed]) + <random>)]] + (in (list (<format> result))))))] [random_bit random.bit code.bit] [random_nat random.nat code.nat] @@ -78,53 +83,58 @@ (with_expansions [<type> (Ex (_ a) [(-> a Code) (Random a)])] - (syntax: .public (random [format <code>.any - random <code>.any]) - (do meta.monad - [pair (meta.eval (type <type>) - (` [(~ format) (~ random)])) - .let [[format random] (as <type> pair)] - seed meta.seed - .let [[_ result] (random.result (random.pcg_32 [..pcg_32_magic_inc seed]) - random)]] - (in (list (format result)))))) + (def: .public random + (syntax (_ [format <code>.any + random <code>.any]) + (do meta.monad + [pair (meta.eval (type <type>) + (` [(~ format) (~ random)])) + .let [[format random] (as <type> pair)] + seed meta.seed + .let [[_ result] (random.result (random.pcg_32 [..pcg_32_magic_inc seed]) + random)]] + (in (list (format result))))))) (with_expansions [<type> (Ex (_ a) [(-> a Code) (Random (List a))])] - (syntax: .public (randoms [format <code>.any - random <code>.any]) - (do meta.monad - [pair (meta.eval (type <type>) - (` [(~ format) (~ random)])) - .let [[format random] (as <type> pair)] - seed meta.seed - .let [[_ result] (random.result (random.pcg_32 [..pcg_32_magic_inc seed]) - random)]] - (in (list#each format result))))) + (def: .public randoms + (syntax (_ [format <code>.any + random <code>.any]) + (do meta.monad + [pair (meta.eval (type <type>) + (` [(~ format) (~ random)])) + .let [[format random] (as <type> pair)] + seed meta.seed + .let [[_ result] (random.result (random.pcg_32 [..pcg_32_magic_inc seed]) + random)]] + (in (list#each format result)))))) -(syntax: .public (if [test <code>.any - then <code>.any - else <code>.any]) - (do meta.monad - [test (meta.eval .Bit test)] - (in (list (.if (as .Bit test) - then - else))))) +(def: .public if + (syntax (_ [test <code>.any + then <code>.any + else <code>.any]) + (do meta.monad + [test (meta.eval .Bit test)] + (in (list (.if (as .Bit test) + then + else)))))) -(syntax: .public (cond [test,then/* (<>.some (<>.and <code>.any <code>.any)) - else <code>.any]) - (in (list (list#mix (function (_ [test then] else) - (` (..if (~ test) - (~ then) - (~ else)))) - else - (list.reversed test,then/*))))) +(def: .public cond + (syntax (_ [test,then/* (<>.some (<>.and <code>.any <code>.any)) + else <code>.any]) + (in (list (list#mix (function (_ [test then] else) + (` (..if (~ test) + (~ then) + (~ else)))) + else + (list.reversed test,then/*)))))) -(syntax: .public (when [test <code>.any - then <code>.any]) - (do meta.monad - [test (meta.eval .Bit test)] - (in (.if (as .Bit test) - (list then) - (list))))) +(def: .public when + (syntax (_ [test <code>.any + then <code>.any]) + (do meta.monad + [test (meta.eval .Bit test)] + (in (.if (as .Bit test) + (list then) + (list)))))) diff --git a/stdlib/source/library/lux/target/jvm/modifier.lux b/stdlib/source/library/lux/target/jvm/modifier.lux index d1cb2807b..68d8d8b7b 100644 --- a/stdlib/source/library/lux/target/jvm/modifier.lux +++ b/stdlib/source/library/lux/target/jvm/modifier.lux @@ -12,7 +12,7 @@ [format ["[0]F" binary (.only Writer)]]] [macro (.only with_symbols) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math ["[0]" number (.only hex) @@ -78,12 +78,13 @@ (|>> !wrap)) ) -(syntax: .public (modifiers: [ofT <code>.any - options (<>.many <code>.any)]) - (with_symbols [g!modifier g!code] - (in (list (` (template [(~ g!code) (~ g!modifier)] - [(def: (~' .public) (~ g!modifier) - (..Modifier (~ ofT)) - ((~! ..modifier) ((~! number.hex) (~ g!code))))] - - (~+ options))))))) +(def: .public modifiers: + (syntax (_ [ofT <code>.any + options (<>.many <code>.any)]) + (with_symbols [g!modifier g!code] + (in (list (` (template [(~ g!code) (~ g!modifier)] + [(def: (~' .public) (~ g!modifier) + (..Modifier (~ ofT)) + ((~! ..modifier) ((~! number.hex) (~ g!code))))] + + (~+ options)))))))) diff --git a/stdlib/source/library/lux/target/lua.lux b/stdlib/source/library/lux/target/lua.lux index 9ececec5f..51c4ac911 100644 --- a/stdlib/source/library/lux/target/lua.lux +++ b/stdlib/source/library/lux/target/lua.lux @@ -16,7 +16,7 @@ [collection ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" template] ["[0]" code]] [math @@ -373,15 +373,17 @@ (abstraction (format "-- " commentary \n+ (representation on)))) ) -(syntax: (arity_inputs [arity <code>.nat]) - (in (case arity - 0 (.list) - _ (|> (-- arity) - (enum.range n.enum 0) - (list#each (|>> %.nat code.local)))))) - -(syntax: (arity_types [arity <code>.nat]) - (in (list.repeated arity (` ..Expression)))) +(def: arity_inputs + (syntax (_ [arity <code>.nat]) + (in (case arity + 0 (.list) + _ (|> (-- arity) + (enum.range n.enum 0) + (list#each (|>> %.nat code.local))))))) + +(def: arity_types + (syntax (_ [arity <code>.nat]) + (in (list.repeated arity (` ..Expression))))) (template [<arity> <function>+] [(with_expansions [<inputs> (arity_inputs <arity>) diff --git a/stdlib/source/library/lux/target/php.lux b/stdlib/source/library/lux/target/php.lux index efb4674c4..73581a5e0 100644 --- a/stdlib/source/library/lux/target/php.lux +++ b/stdlib/source/library/lux/target/php.lux @@ -16,7 +16,7 @@ [collection ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" template] ["[0]" code]] [math @@ -232,15 +232,17 @@ ..group abstraction))) - (syntax: (arity_inputs [arity <code>.nat]) - (in (case arity - 0 (.list) - _ (|> (-- arity) - (enum.range n.enum 0) - (list#each (|>> %.nat code.local)))))) - - (syntax: (arity_types [arity <code>.nat]) - (in (list.repeated arity (` ..Expression)))) + (def: arity_inputs + (syntax (_ [arity <code>.nat]) + (in (case arity + 0 (.list) + _ (|> (-- arity) + (enum.range n.enum 0) + (list#each (|>> %.nat code.local))))))) + + (def: arity_types + (syntax (_ [arity <code>.nat]) + (in (list.repeated arity (` ..Expression))))) (template [<arity> <function>+] [(with_expansions [<apply> (template.symbol ["apply/" <arity>]) diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index 6ce709536..03033e4be 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -17,7 +17,7 @@ [collection ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" template] ["[0]" code]] [math @@ -451,15 +451,17 @@ (representation on)))) ) -(syntax: (arity_inputs [arity <code>.nat]) - (in (case arity - 0 (.list) - _ (|> (-- arity) - (enum.range n.enum 0) - (list#each (|>> %.nat code.local)))))) - -(syntax: (arity_types [arity <code>.nat]) - (in (list.repeated arity (` (Expression Any))))) +(def: arity_inputs + (syntax (_ [arity <code>.nat]) + (in (case arity + 0 (.list) + _ (|> (-- arity) + (enum.range n.enum 0) + (list#each (|>> %.nat code.local))))))) + +(def: arity_types + (syntax (_ [arity <code>.nat]) + (in (list.repeated arity (` (Expression Any)))))) (template [<arity> <function>+] [(with_expansions [<inputs> (arity_inputs <arity>) diff --git a/stdlib/source/library/lux/target/r.lux b/stdlib/source/library/lux/target/r.lux index 0d4e813dc..15cf46b21 100644 --- a/stdlib/source/library/lux/target/r.lux +++ b/stdlib/source/library/lux/target/r.lux @@ -13,7 +13,7 @@ [collection ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" template] ["[0]" code]] [math @@ -209,15 +209,17 @@ kw_args)) ")")))) - (syntax: (arity_inputs [arity <code>.nat]) - (in (case arity - 0 (.list) - _ (|> arity - list.indices - (list#each (|>> %.nat code.local)))))) - - (syntax: (arity_types [arity <code>.nat]) - (in (list.repeated arity (` ..Expression)))) + (def: arity_inputs + (syntax (_ [arity <code>.nat]) + (in (case arity + 0 (.list) + _ (|> arity + list.indices + (list#each (|>> %.nat code.local))))))) + + (def: arity_types + (syntax (_ [arity <code>.nat]) + (in (list.repeated arity (` ..Expression))))) (template [<arity> <function>+] [(with_expansions [<apply> (template.symbol ["apply/" <arity>]) diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index e48a96d1b..3942e8af0 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -16,7 +16,7 @@ [collection ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" template] ["[0]" code]] [math @@ -481,15 +481,17 @@ (|> lambda (..do "call" args {.#None}))) -(syntax: (arity_inputs [arity <code>.nat]) - (in (case arity - 0 (.list) - _ (|> (-- arity) - (enum.range n.enum 0) - (list#each (|>> %.nat code.local)))))) - -(syntax: (arity_types [arity <code>.nat]) - (in (list.repeated arity (` ..Expression)))) +(def: arity_inputs + (syntax (_ [arity <code>.nat]) + (in (case arity + 0 (.list) + _ (|> (-- arity) + (enum.range n.enum 0) + (list#each (|>> %.nat code.local))))))) + +(def: arity_types + (syntax (_ [arity <code>.nat]) + (in (list.repeated arity (` ..Expression))))) (template [<arity> <function>+] [(with_expansions [<apply> (template.symbol ["apply/" <arity>]) diff --git a/stdlib/source/library/lux/test.lux b/stdlib/source/library/lux/test.lux index a3ab5b1c0..b3ec2b657 100644 --- a/stdlib/source/library/lux/test.lux +++ b/stdlib/source/library/lux/test.lux @@ -34,7 +34,7 @@ ["n" nat] ["f" frac]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] ["[0]" meta (.only) ["[0]" symbol]] @@ -304,10 +304,11 @@ (code.tuple (list (code.text (symbol.module symbol)) (code.text (symbol.short symbol))))) -(syntax: (reference [name <code>.symbol]) - (do meta.monad - [_ (meta.export name)] - (in (list (symbol_code name))))) +(def: reference + (syntax (_ [name <code>.symbol]) + (do meta.monad + [_ (meta.export name)] + (in (list (symbol_code name)))))) (def: coverage_separator Text @@ -333,29 +334,31 @@ (set.has [module remaining] output)))) (template [<macro> <function>] - [(syntax: .public (<macro> [coverage (<code>.tuple (<>.many <code>.any)) - condition <code>.any]) - (let [coverage (list#each (function (_ definition) - (` ((~! ..reference) (~ definition)))) - coverage)] - (in (list (` ((~! <function>) - (is (.List .Symbol) - (.list (~+ coverage))) - (~ condition)))))))] + [(def: .public <macro> + (syntax (_ [coverage (<code>.tuple (<>.many <code>.any)) + condition <code>.any]) + (let [coverage (list#each (function (_ definition) + (` ((~! ..reference) (~ definition)))) + coverage)] + (in (list (` ((~! <function>) + (is (.List .Symbol) + (.list (~+ coverage))) + (~ condition))))))))] [coverage' ..|coverage'|] [coverage ..|coverage|] ) -(syntax: .public (for [coverage (<code>.tuple (<>.many <code>.any)) - test <code>.any]) - (let [coverage (list#each (function (_ definition) - (` ((~! ..reference) (~ definition)))) - coverage)] - (in (list (` ((~! ..|for|) - (is (.List .Symbol) - (.list (~+ coverage))) - (~ test))))))) +(def: .public for + (syntax (_ [coverage (<code>.tuple (<>.many <code>.any)) + test <code>.any]) + (let [coverage (list#each (function (_ definition) + (` ((~! ..reference) (~ definition)))) + coverage)] + (in (list (` ((~! ..|for|) + (is (.List .Symbol) + (.list (~+ coverage))) + (~ test)))))))) (def: (covering' module coverage test) (-> Text Text Test Test) @@ -367,22 +370,23 @@ (text.replaced (format ..clean_up_marker module symbol.separator) "") (text.replaced ..clean_up_marker ""))])))))) -(syntax: .public (covering [module <code>.symbol - test <code>.any]) - (do meta.monad - [.let [module (symbol.module module)] - definitions (meta.definitions module) - .let [coverage (|> definitions - (list#mix (function (_ [short [exported? _]] aggregate) - (if exported? - {.#Item short aggregate} - aggregate)) - {.#End}) - ..encoded_coverage)]] - (in (list (` ((~! ..covering') - (~ (code.text module)) - (~ (code.text coverage)) - (~ test))))))) +(def: .public covering + (syntax (_ [module <code>.symbol + test <code>.any]) + (do meta.monad + [.let [module (symbol.module module)] + definitions (meta.definitions module) + .let [coverage (|> definitions + (list#mix (function (_ [short [exported? _]] aggregate) + (if exported? + {.#Item short aggregate} + aggregate)) + {.#End}) + ..encoded_coverage)]] + (in (list (` ((~! ..covering') + (~ (code.text module)) + (~ (code.text coverage)) + (~ test)))))))) (exception: .public (error_during_execution [error Text]) (exception.report diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux index 7274cbe00..b3c99bdbf 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux @@ -20,7 +20,7 @@ [collection ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro - [syntax (.only syntax:)]] + [syntax (.only syntax)]] [math [number ["n" nat] @@ -170,10 +170,11 @@ [abstraction inputs]))) (template [<name> <tag>] - [(syntax: .public (<name> [content <code>.any]) - (in (list (` (.<| {..#Reference} - <tag> - (~ content))))))] + [(def: .public <name> + (syntax (_ [content <code>.any]) + (in (list (` (.<| {..#Reference} + <tag> + (~ content)))))))] [variable {reference.#Variable}] [constant {reference.#Constant}] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux index 1257c661a..bb9c5681f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux @@ -17,7 +17,7 @@ ["[0]" list (.open: "[1]#[0]" functor monoid)] ["[0]" sequence]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math [number (.only hex) @@ -87,55 +87,57 @@ (-> (Expression Any) (Computation Any)) (|>> [1 #1] ..variant)) -(syntax: .public (with_vars [vars (<code>.tuple (<>.some <code>.local)) - body <code>.any]) - (do [! meta.monad] - [ids (monad.all ! (list.repeated (list.size vars) meta.seed))] - (in (list (` (let [(~+ (|> vars - (list.zipped_2 ids) - (list#each (function (_ [id var]) - (list (code.local var) - (` (_.var (~ (code.text (format "v" (%.nat id))))))))) - list.together))] - (~ body))))))) - -(syntax: (runtime: [declaration (<>.or <code>.local - (<code>.form (<>.and <code>.local - (<>.some <code>.local)))) - code <code>.any]) - (do meta.monad - [runtime_id meta.seed] - (macro.with_symbols [g!_] - (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) - runtime_name (` (_.var (~ (code.text (%.code runtime)))))] - (case declaration - {.#Left name} - (let [g!name (code.local name) - code_nameC (code.local (format "@" name))] - (in (list (` (def: .public (~ g!name) - _.Var/1 - (~ runtime_name))) - - (` (def: (~ code_nameC) - (_.Expression Any) - (_.defparameter (~ runtime_name) (~ code))))))) - - {.#Right [name inputs]} - (let [g!name (code.local name) - code_nameC (code.local (format "@" name)) - - inputsC (list#each code.local inputs) - inputs_typesC (list#each (function.constant (` (_.Expression Any))) - inputs)] - (in (list (` (def: .public ((~ g!name) (~+ inputsC)) - (-> (~+ inputs_typesC) (_.Computation Any)) - (_.call/* (~ runtime_name) (list (~+ inputsC))))) - - (` (def: (~ code_nameC) - (_.Expression Any) - (..with_vars [(~+ inputsC)] - (_.defun (~ runtime_name) (_.args (list (~+ inputsC))) - (~ code))))))))))))) +(def: .public with_vars + (syntax (_ [vars (<code>.tuple (<>.some <code>.local)) + body <code>.any]) + (do [! meta.monad] + [ids (monad.all ! (list.repeated (list.size vars) meta.seed))] + (in (list (` (let [(~+ (|> vars + (list.zipped_2 ids) + (list#each (function (_ [id var]) + (list (code.local var) + (` (_.var (~ (code.text (format "v" (%.nat id))))))))) + list.together))] + (~ body)))))))) + +(def: runtime: + (syntax (_ [declaration (<>.or <code>.local + (<code>.form (<>.and <code>.local + (<>.some <code>.local)))) + code <code>.any]) + (do meta.monad + [runtime_id meta.seed] + (macro.with_symbols [g!_] + (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) + runtime_name (` (_.var (~ (code.text (%.code runtime)))))] + (case declaration + {.#Left name} + (let [g!name (code.local name) + code_nameC (code.local (format "@" name))] + (in (list (` (def: .public (~ g!name) + _.Var/1 + (~ runtime_name))) + + (` (def: (~ code_nameC) + (_.Expression Any) + (_.defparameter (~ runtime_name) (~ code))))))) + + {.#Right [name inputs]} + (let [g!name (code.local name) + code_nameC (code.local (format "@" name)) + + inputsC (list#each code.local inputs) + inputs_typesC (list#each (function.constant (` (_.Expression Any))) + inputs)] + (in (list (` (def: .public ((~ g!name) (~+ inputsC)) + (-> (~+ inputs_typesC) (_.Computation Any)) + (_.call/* (~ runtime_name) (list (~+ inputsC))))) + + (` (def: (~ code_nameC) + (_.Expression Any) + (..with_vars [(~+ inputsC)] + (_.defun (~ runtime_name) (_.args (list (~+ inputsC))) + (~ code)))))))))))))) (runtime: (lux//try op) (with_vars [error] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux index 317114afc..8f5c9db8a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux @@ -12,7 +12,7 @@ ["[0]" meta] ["[0]" macro (.only with_symbols) ["[0]" code] - [syntax (.only syntax:)]]]] + [syntax (.only syntax)]]]] ["[0]" /// ["[1][0]" extension] [// @@ -21,9 +21,10 @@ [/// ["[1]" phase]]]]) -(syntax: (Vector [size <code>.nat - elemT <code>.any]) - (in (list (` [(~+ (list.repeated size elemT))])))) +(def: Vector + (syntax (_ [size <code>.nat + elemT <code>.any]) + (in (list (` [(~+ (list.repeated size elemT))]))))) (type: .public (Nullary of) (-> (Vector 0 of) of)) (type: .public (Unary of) (-> (Vector 1 of) of)) @@ -31,28 +32,29 @@ (type: .public (Trinary of) (-> (Vector 3 of) of)) (type: .public (Variadic of) (-> (List of) of)) -(syntax: (arity: [arity <code>.nat - name <code>.local - type <code>.any]) - (with_symbols [g!_ g!extension g!name g!phase g!archive g!inputs g!of g!anchor g!expression g!directive] - (do [! meta.monad] - [g!input+ (monad.all ! (list.repeated arity (macro.symbol "input")))] - (in (list (` (def: .public ((~ (code.local name)) (~ g!extension)) - (All ((~ g!_) (~ g!anchor) (~ g!expression) (~ g!directive)) - (-> ((~ type) (~ g!expression)) - (generation.Handler (~ g!anchor) (~ g!expression) (~ g!directive)))) - (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs)) - (case (~ g!inputs) - (pattern (list (~+ g!input+))) - (do ///.monad - [(~+ (|> g!input+ - (list#each (function (_ g!input) - (list g!input (` ((~ g!phase) (~ g!archive) (~ g!input)))))) - list.together))] - ((~' in) ((~ g!extension) [(~+ g!input+)]))) +(def: arity: + (syntax (_ [arity <code>.nat + name <code>.local + type <code>.any]) + (with_symbols [g!_ g!extension g!name g!phase g!archive g!inputs g!of g!anchor g!expression g!directive] + (do [! meta.monad] + [g!input+ (monad.all ! (list.repeated arity (macro.symbol "input")))] + (in (list (` (def: .public ((~ (code.local name)) (~ g!extension)) + (All ((~ g!_) (~ g!anchor) (~ g!expression) (~ g!directive)) + (-> ((~ type) (~ g!expression)) + (generation.Handler (~ g!anchor) (~ g!expression) (~ g!directive)))) + (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs)) + (case (~ g!inputs) + (pattern (list (~+ g!input+))) + (do ///.monad + [(~+ (|> g!input+ + (list#each (function (_ g!input) + (list g!input (` ((~ g!phase) (~ g!archive) (~ g!input)))))) + list.together))] + ((~' in) ((~ g!extension) [(~+ g!input+)]))) - (~' _) - (///.except ///extension.incorrect_arity [(~ g!name) 1 (list.size (~ g!inputs))])))))))))) + (~' _) + (///.except ///extension.incorrect_arity [(~ g!name) 1 (list.size (~ g!inputs))]))))))))))) (arity: 0 nullary ..Nullary) (arity: 1 unary ..Unary) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux index c8f77a38e..444254018 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux @@ -18,7 +18,7 @@ ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" sequence]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math [number (.only hex) @@ -81,52 +81,54 @@ (-> Var (-> Var Expression) Statement) (_.define name (definition name))) -(syntax: .public (with_vars [vars (<code>.tuple (<>.some <code>.local)) - body <code>.any]) - (do [! meta.monad] - [ids (monad.all ! (list.repeated (list.size vars) meta.seed))] - (in (list (` (let [(~+ (|> vars - (list.zipped_2 ids) - (list#each (function (_ [id var]) - (list (code.local var) - (` (_.var (~ (code.text (format "v" (%.nat id))))))))) - list.together))] - (~ body))))))) - -(syntax: (runtime: [declaration (<>.or <code>.local - (<code>.form (<>.and <code>.local - (<>.some <code>.local)))) - code <code>.any]) - (macro.with_symbols [g!_ runtime] - (let [runtime_name (` (_.var (~ (code.text (%.code runtime)))))] - (case declaration - {.#Left name} - (let [g!name (code.local name)] - (in (list (` (def: .public (~ g!name) - Var - (~ runtime_name))) - - (` (def: (~ (code.local (format "@" name))) - Statement - (..feature (~ runtime_name) - (function ((~ g!_) (~ g!name)) - (~ code)))))))) - - {.#Right [name inputs]} - (let [g!name (code.local name) - inputsC (list#each code.local inputs) - inputs_typesC (list#each (function.constant (` _.Expression)) inputs)] - (in (list (` (def: .public ((~ g!name) (~+ inputsC)) - (-> (~+ inputs_typesC) Computation) - (_.apply (~ runtime_name) (list (~+ inputsC))))) - - (` (def: (~ (code.local (format "@" name))) - Statement - (..feature (~ runtime_name) - (function ((~ g!_) (~ g!_)) - (..with_vars [(~+ inputsC)] - (_.function (~ g!_) (list (~+ inputsC)) - (~ code)))))))))))))) +(def: .public with_vars + (syntax (_ [vars (<code>.tuple (<>.some <code>.local)) + body <code>.any]) + (do [! meta.monad] + [ids (monad.all ! (list.repeated (list.size vars) meta.seed))] + (in (list (` (let [(~+ (|> vars + (list.zipped_2 ids) + (list#each (function (_ [id var]) + (list (code.local var) + (` (_.var (~ (code.text (format "v" (%.nat id))))))))) + list.together))] + (~ body)))))))) + +(def: runtime: + (syntax (_ [declaration (<>.or <code>.local + (<code>.form (<>.and <code>.local + (<>.some <code>.local)))) + code <code>.any]) + (macro.with_symbols [g!_ runtime] + (let [runtime_name (` (_.var (~ (code.text (%.code runtime)))))] + (case declaration + {.#Left name} + (let [g!name (code.local name)] + (in (list (` (def: .public (~ g!name) + Var + (~ runtime_name))) + + (` (def: (~ (code.local (format "@" name))) + Statement + (..feature (~ runtime_name) + (function ((~ g!_) (~ g!name)) + (~ code)))))))) + + {.#Right [name inputs]} + (let [g!name (code.local name) + inputsC (list#each code.local inputs) + inputs_typesC (list#each (function.constant (` _.Expression)) inputs)] + (in (list (` (def: .public ((~ g!name) (~+ inputsC)) + (-> (~+ inputs_typesC) Computation) + (_.apply (~ runtime_name) (list (~+ inputsC))))) + + (` (def: (~ (code.local (format "@" name))) + Statement + (..feature (~ runtime_name) + (function ((~ g!_) (~ g!_)) + (..with_vars [(~+ inputsC)] + (_.function (~ g!_) (list (~+ inputsC)) + (~ code))))))))))))))) (def: length (-> Expression Computation) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux index a286396f4..93f3cb980 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux @@ -18,7 +18,7 @@ ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" sequence]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math [number (.only hex) @@ -103,61 +103,63 @@ (-> Var (-> Var Statement) Statement) (definition name)) -(syntax: .public (with_vars [vars (<code>.tuple (<>.some <code>.local)) - body <code>.any]) - (do [! meta.monad] - [ids (monad.all ! (list.repeated (list.size vars) meta.seed))] - (in (list (` (let [(~+ (|> vars - (list.zipped_2 ids) - (list#each (function (_ [id var]) - (list (code.local var) - (` (_.var (~ (code.text (format "v" (%.nat id))))))))) - list.together))] - (~ body))))))) +(def: .public with_vars + (syntax (_ [vars (<code>.tuple (<>.some <code>.local)) + body <code>.any]) + (do [! meta.monad] + [ids (monad.all ! (list.repeated (list.size vars) meta.seed))] + (in (list (` (let [(~+ (|> vars + (list.zipped_2 ids) + (list#each (function (_ [id var]) + (list (code.local var) + (` (_.var (~ (code.text (format "v" (%.nat id))))))))) + list.together))] + (~ body)))))))) (def: module_id 0) -(syntax: (runtime: [declaration (<>.or <code>.local - (<code>.form (<>.and <code>.local - (<>.some <code>.local)))) - code <code>.any]) - (do meta.monad - [runtime_id meta.seed] - (macro.with_symbols [g!_] - (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) - runtime_name (` (_.var (~ (code.text (%.code runtime)))))] - (case declaration - {.#Left name} - (macro.with_symbols [g!_] - (let [g!name (code.local name)] - (in (list (` (def: .public (~ g!name) - Var - (~ runtime_name))) - - (` (def: (~ (code.local (format "@" name))) - Statement - (..feature (~ runtime_name) - (function ((~ g!_) (~ g!name)) - (_.set (~ g!name) (~ code)))))))))) - - {.#Right [name inputs]} - (macro.with_symbols [g!_] - (let [g!name (code.local name) - inputsC (list#each code.local inputs) - inputs_typesC (list#each (function.constant (` _.Expression)) - inputs)] - (in (list (` (def: .public ((~ g!name) (~+ inputsC)) - (-> (~+ inputs_typesC) Computation) - (_.apply (list (~+ inputsC)) (~ runtime_name)))) - - (` (def: (~ (code.local (format "@" name))) - Statement - (..feature (~ runtime_name) - (function ((~ g!_) (~ g!_)) - (..with_vars [(~+ inputsC)] - (_.function (~ g!_) (list (~+ inputsC)) - (~ code)))))))))))))))) +(def: runtime: + (syntax (_ [declaration (<>.or <code>.local + (<code>.form (<>.and <code>.local + (<>.some <code>.local)))) + code <code>.any]) + (do meta.monad + [runtime_id meta.seed] + (macro.with_symbols [g!_] + (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) + runtime_name (` (_.var (~ (code.text (%.code runtime)))))] + (case declaration + {.#Left name} + (macro.with_symbols [g!_] + (let [g!name (code.local name)] + (in (list (` (def: .public (~ g!name) + Var + (~ runtime_name))) + + (` (def: (~ (code.local (format "@" name))) + Statement + (..feature (~ runtime_name) + (function ((~ g!_) (~ g!name)) + (_.set (~ g!name) (~ code)))))))))) + + {.#Right [name inputs]} + (macro.with_symbols [g!_] + (let [g!name (code.local name) + inputsC (list#each code.local inputs) + inputs_typesC (list#each (function.constant (` _.Expression)) + inputs)] + (in (list (` (def: .public ((~ g!name) (~+ inputsC)) + (-> (~+ inputs_typesC) Computation) + (_.apply (list (~+ inputsC)) (~ runtime_name)))) + + (` (def: (~ (code.local (format "@" name))) + Statement + (..feature (~ runtime_name) + (function ((~ g!_) (~ g!_)) + (..with_vars [(~+ inputsC)] + (_.function (~ g!_) (list (~+ inputsC)) + (~ code))))))))))))))))) (def: (item index table) (-> Expression Expression Location) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux index cb5b3c882..5c22acced 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux @@ -18,7 +18,7 @@ ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" sequence]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math [number (.only hex) @@ -70,62 +70,64 @@ (-> Constant (-> Constant Statement) Statement) (definition name)) -(syntax: .public (with_vars [vars (<code>.tuple (<>.some <code>.local)) - body <code>.any]) - (do [! meta.monad] - [ids (monad.all ! (list.repeated (list.size vars) meta.seed))] - (in (list (` (let [(~+ (|> vars - (list.zipped_2 ids) - (list#each (function (_ [id var]) - (list (code.local var) - (` (_.var (~ (code.text (format "v" (%.nat id))))))))) - list.together))] - (~ body))))))) +(def: .public with_vars + (syntax (_ [vars (<code>.tuple (<>.some <code>.local)) + body <code>.any]) + (do [! meta.monad] + [ids (monad.all ! (list.repeated (list.size vars) meta.seed))] + (in (list (` (let [(~+ (|> vars + (list.zipped_2 ids) + (list#each (function (_ [id var]) + (list (code.local var) + (` (_.var (~ (code.text (format "v" (%.nat id))))))))) + list.together))] + (~ body)))))))) (def: module_id 0) -(syntax: (runtime: [declaration (<>.or <code>.local - (<code>.form (<>.and <code>.local - (<>.some <code>.local)))) - code <code>.any]) - (do meta.monad - [runtime_id meta.seed] - (macro.with_symbols [g!_] - (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) - runtime_name (` (_.constant (~ (code.text (%.code runtime)))))] - (case declaration - {.#Left name} - (macro.with_symbols [g!_] - (let [g!name (code.local name)] - (in (list (` (def: .public (~ g!name) - Var - (~ runtime_name))) - - (` (def: (~ (code.local (format "@" name))) - Statement - (..feature (~ runtime_name) - (function ((~ g!_) (~ g!name)) - (_.define (~ g!name) (~ code)))))))))) - - {.#Right [name inputs]} - (macro.with_symbols [g!_] - (let [g!name (code.local name) - inputsC (list#each code.local inputs) - inputs_typesC (list#each (function.constant (` _.Expression)) - inputs)] - (in (list (` (def: .public ((~ g!name) (~+ inputsC)) - (-> (~+ inputs_typesC) Computation) - (_.apply (list (~+ inputsC)) (~ runtime_name)))) - - (` (def: (~ (code.local (format "@" name))) - Statement - (..feature (~ runtime_name) - (function ((~ g!_) (~ g!_)) - (..with_vars [(~+ inputsC)] - (_.define_function (~ g!_) - (list (~+ (list#each (|>> (~) [false] (`)) inputsC))) - (~ code)))))))))))))))) +(def: runtime: + (syntax (_ [declaration (<>.or <code>.local + (<code>.form (<>.and <code>.local + (<>.some <code>.local)))) + code <code>.any]) + (do meta.monad + [runtime_id meta.seed] + (macro.with_symbols [g!_] + (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) + runtime_name (` (_.constant (~ (code.text (%.code runtime)))))] + (case declaration + {.#Left name} + (macro.with_symbols [g!_] + (let [g!name (code.local name)] + (in (list (` (def: .public (~ g!name) + Var + (~ runtime_name))) + + (` (def: (~ (code.local (format "@" name))) + Statement + (..feature (~ runtime_name) + (function ((~ g!_) (~ g!name)) + (_.define (~ g!name) (~ code)))))))))) + + {.#Right [name inputs]} + (macro.with_symbols [g!_] + (let [g!name (code.local name) + inputsC (list#each code.local inputs) + inputs_typesC (list#each (function.constant (` _.Expression)) + inputs)] + (in (list (` (def: .public ((~ g!name) (~+ inputsC)) + (-> (~+ inputs_typesC) Computation) + (_.apply (list (~+ inputsC)) (~ runtime_name)))) + + (` (def: (~ (code.local (format "@" name))) + Statement + (..feature (~ runtime_name) + (function ((~ g!_) (~ g!_)) + (..with_vars [(~+ inputsC)] + (_.define_function (~ g!_) + (list (~+ (list#each (|>> (~) [false] (`)) inputsC))) + (~ code))))))))))))))))) (runtime: (io//log! message) (all _.then diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux index 1530c23eb..8ed7f8bb8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux @@ -17,7 +17,7 @@ ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" sequence]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math [number (.only hex) @@ -109,53 +109,55 @@ (-> SVar (-> SVar (Statement Any)) (Statement Any)) (definition name)) -(syntax: .public (with_vars [vars (<code>.tuple (<>.some <code>.local)) - body <code>.any]) - (do [! meta.monad] - [ids (monad.all ! (list.repeated (list.size vars) meta.seed))] - (in (list (` (let [(~+ (|> vars - (list.zipped_2 ids) - (list#each (function (_ [id var]) - (list (code.local var) - (` (_.var (~ (code.text (format "v" (%.nat id))))))))) - list.together))] - (~ body))))))) - -(syntax: (runtime: [declaration (<>.or <code>.local - (<code>.form (<>.and <code>.local - (<>.some <code>.local)))) - code <code>.any]) - (case declaration - {.#Left name} - (macro.with_symbols [g!_] - (let [nameC (code.local name) - code_nameC (code.local (format "@" name)) - runtime_nameC (` (runtime_name (~ (code.text name))))] - (in (list (` (def: .public (~ nameC) SVar (~ runtime_nameC))) - (` (def: (~ code_nameC) - (Statement Any) - (..feature (~ runtime_nameC) - (function ((~ g!_) (~ g!_)) - (_.set (list (~ g!_)) (~ code)))))))))) - - {.#Right [name inputs]} - (macro.with_symbols [g!_] - (let [nameC (code.local name) - code_nameC (code.local (format "@" name)) - runtime_nameC (` (runtime_name (~ (code.text name)))) - inputsC (list#each code.local inputs) - inputs_typesC (list#each (function.constant (` (_.Expression Any))) - inputs)] - (in (list (` (def: .public ((~ nameC) (~+ inputsC)) - (-> (~+ inputs_typesC) (Computation Any)) - (_.apply (list (~+ inputsC)) (~ runtime_nameC)))) - (` (def: (~ code_nameC) - (Statement Any) - (..feature (~ runtime_nameC) - (function ((~ g!_) (~ g!_)) - (..with_vars [(~+ inputsC)] - (_.def (~ g!_) (list (~+ inputsC)) - (~ code))))))))))))) +(def: .public with_vars + (syntax (_ [vars (<code>.tuple (<>.some <code>.local)) + body <code>.any]) + (do [! meta.monad] + [ids (monad.all ! (list.repeated (list.size vars) meta.seed))] + (in (list (` (let [(~+ (|> vars + (list.zipped_2 ids) + (list#each (function (_ [id var]) + (list (code.local var) + (` (_.var (~ (code.text (format "v" (%.nat id))))))))) + list.together))] + (~ body)))))))) + +(def: runtime: + (syntax (_ [declaration (<>.or <code>.local + (<code>.form (<>.and <code>.local + (<>.some <code>.local)))) + code <code>.any]) + (case declaration + {.#Left name} + (macro.with_symbols [g!_] + (let [nameC (code.local name) + code_nameC (code.local (format "@" name)) + runtime_nameC (` (runtime_name (~ (code.text name))))] + (in (list (` (def: .public (~ nameC) SVar (~ runtime_nameC))) + (` (def: (~ code_nameC) + (Statement Any) + (..feature (~ runtime_nameC) + (function ((~ g!_) (~ g!_)) + (_.set (list (~ g!_)) (~ code)))))))))) + + {.#Right [name inputs]} + (macro.with_symbols [g!_] + (let [nameC (code.local name) + code_nameC (code.local (format "@" name)) + runtime_nameC (` (runtime_name (~ (code.text name)))) + inputsC (list#each code.local inputs) + inputs_typesC (list#each (function.constant (` (_.Expression Any))) + inputs)] + (in (list (` (def: .public ((~ nameC) (~+ inputsC)) + (-> (~+ inputs_typesC) (Computation Any)) + (_.apply (list (~+ inputsC)) (~ runtime_nameC)))) + (` (def: (~ code_nameC) + (Statement Any) + (..feature (~ runtime_nameC) + (function ((~ g!_) (~ g!_)) + (..with_vars [(~+ inputsC)] + (_.def (~ g!_) (list (~+ inputsC)) + (~ code)))))))))))))) (runtime: (lux::try op) (with_vars [exception] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux index 8b5adc004..025abf8f6 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux @@ -12,7 +12,7 @@ (dictionary ["dict" unordered (.only Dict)]))) [macro (.only with_symbols)] (macro [code] - ["s" syntax (.only syntax:)]) + ["s" syntax (.only syntax)]) [host]) (luxc ["&" lang] (lang ["la" analysis] @@ -34,9 +34,10 @@ (type: .public Bundle (Dict Text Proc)) -(syntax: (Vector [size <code>.nat - elemT <code>.any]) - (in (list (` [(~+ (list.repeated size elemT))])))) +(def: Vector + (syntax (_ [size <code>.nat + elemT <code>.any]) + (in (list (` [(~+ (list.repeated size elemT))]))))) (type: .public Nullary (-> (Vector +0 Expression) Expression)) (type: .public Unary (-> (Vector +1 Expression) Expression)) @@ -63,27 +64,28 @@ "Expected: " (|> expected .int %i) "\n" " Actual: " (|> actual .int %i))) -(syntax: (arity: [name s.local - arity s.nat]) - (with_symbols [g!_ g!proc g!name g!translate g!inputs] - (do [@ macro.monad] - [g!input+ (monad.all @ (list.repeated arity (macro.symbol "input")))] - (in (list (` (def: .public ((~ (code.local name)) (~ g!proc)) - (-> (-> (..Vector (~ (code.nat arity)) Expression) Expression) - (-> Text ..Proc)) - (function ((~ g!_) (~ g!name)) - (function ((~ g!_) (~ g!translate) (~ g!inputs)) - (case (~ g!inputs) - (pattern (list (~+ g!input+))) - (do macro.Monad<Meta> - [(~+ (|> g!input+ - (list/each (function (_ g!input) - (list g!input (` ((~ g!translate) (~ g!input)))))) - list.together))] - ((~' in) ((~ g!proc) [(~+ g!input+)]))) - - (~' _) - (macro.failure (wrong_arity (~ g!name) +1 (list.size (~ g!inputs)))))))))))))) +(def: arity: + (syntax (_ [name s.local + arity s.nat]) + (with_symbols [g!_ g!proc g!name g!translate g!inputs] + (do [@ macro.monad] + [g!input+ (monad.all @ (list.repeated arity (macro.symbol "input")))] + (in (list (` (def: .public ((~ (code.local name)) (~ g!proc)) + (-> (-> (..Vector (~ (code.nat arity)) Expression) Expression) + (-> Text ..Proc)) + (function ((~ g!_) (~ g!name)) + (function ((~ g!_) (~ g!translate) (~ g!inputs)) + (case (~ g!inputs) + (pattern (list (~+ g!input+))) + (do macro.Monad<Meta> + [(~+ (|> g!input+ + (list/each (function (_ g!input) + (list g!input (` ((~ g!translate) (~ g!input)))))) + list.together))] + ((~' in) ((~ g!proc) [(~+ g!input+)]))) + + (~' _) + (macro.failure (wrong_arity (~ g!name) +1 (list.size (~ g!inputs))))))))))))))) (arity: nullary +0) (arity: unary +1) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux index 8e4686a3d..e44c646d7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux @@ -18,7 +18,7 @@ ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" sequence]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math [number (.only hex) @@ -76,53 +76,55 @@ ... else (.int input))) -(syntax: .public (with_vars [vars (<code>.tuple (<>.some <code>.local)) - body <code>.any]) - (do [! meta.monad] - [ids (monad.all ! (list.repeated (list.size vars) meta.seed))] - (in (list (` (let [(~+ (|> vars - (list.zipped_2 ids) - (list#each (function (_ [id var]) - (list (code.local var) - (` (_.var (~ (code.text (format "v" (%.nat id))))))))) - list.together))] - (~ body))))))) - -(syntax: (runtime: [declaration (<>.or <code>.local - (<code>.form (<>.and <code>.local - (<>.some <code>.local)))) - code <code>.any]) - (do meta.monad - [runtime_id meta.seed] - (macro.with_symbols [g!_] - (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) - runtime_name (` (_.var (~ (code.text (%.code runtime)))))] - (case declaration - {.#Left name} - (let [g!name (code.local name)] - (in (list (` (def: .public (~ g!name) - _.SVar - (~ runtime_name))) - - (` (def: (~ (code.local (format "@" name))) - _.Expression - (_.set! (~ runtime_name) (~ code))))))) - - {.#Right [name inputs]} - (let [g!name (code.local name) - inputsC (list#each code.local inputs) - inputs_typesC (list#each (function.constant (` _.Expression)) - inputs)] - (in (list (` (def: .public ((~ g!name) (~+ inputsC)) - (-> (~+ inputs_typesC) _.Expression) - (_.apply (list (~+ inputsC)) (~ runtime_name)))) - - (` (def: (~ (code.local (format "@" name))) - _.Expression - (..with_vars [(~+ inputsC)] - (_.set! (~ runtime_name) - (_.function (list (~+ inputsC)) - (~ code)))))))))))))) +(def: .public with_vars + (syntax (_ [vars (<code>.tuple (<>.some <code>.local)) + body <code>.any]) + (do [! meta.monad] + [ids (monad.all ! (list.repeated (list.size vars) meta.seed))] + (in (list (` (let [(~+ (|> vars + (list.zipped_2 ids) + (list#each (function (_ [id var]) + (list (code.local var) + (` (_.var (~ (code.text (format "v" (%.nat id))))))))) + list.together))] + (~ body)))))))) + +(def: runtime: + (syntax (_ [declaration (<>.or <code>.local + (<code>.form (<>.and <code>.local + (<>.some <code>.local)))) + code <code>.any]) + (do meta.monad + [runtime_id meta.seed] + (macro.with_symbols [g!_] + (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) + runtime_name (` (_.var (~ (code.text (%.code runtime)))))] + (case declaration + {.#Left name} + (let [g!name (code.local name)] + (in (list (` (def: .public (~ g!name) + _.SVar + (~ runtime_name))) + + (` (def: (~ (code.local (format "@" name))) + _.Expression + (_.set! (~ runtime_name) (~ code))))))) + + {.#Right [name inputs]} + (let [g!name (code.local name) + inputsC (list#each code.local inputs) + inputs_typesC (list#each (function.constant (` _.Expression)) + inputs)] + (in (list (` (def: .public ((~ g!name) (~+ inputsC)) + (-> (~+ inputs_typesC) _.Expression) + (_.apply (list (~+ inputsC)) (~ runtime_name)))) + + (` (def: (~ (code.local (format "@" name))) + _.Expression + (..with_vars [(~+ inputsC)] + (_.set! (~ runtime_name) + (_.function (list (~+ inputsC)) + (~ code))))))))))))))) (def: .public variant_tag_field "luxVT") (def: .public variant_flag_field "luxVF") diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux index f21273b23..85a7286c1 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux @@ -18,7 +18,7 @@ ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" sequence]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math [number (.only hex) @@ -68,17 +68,18 @@ ..unit _.nil)) -(syntax: .public (with_vars [vars (<code>.tuple (<>.some <code>.local)) - body <code>.any]) - (do [! meta.monad] - [ids (monad.all ! (list.repeated (list.size vars) meta.seed))] - (in (list (` (let [(~+ (|> vars - (list.zipped_2 ids) - (list#each (function (_ [id var]) - (list (code.local var) - (` (_.local (~ (code.text (format "v" (%.nat id))))))))) - list.together))] - (~ body))))))) +(def: .public with_vars + (syntax (_ [vars (<code>.tuple (<>.some <code>.local)) + body <code>.any]) + (do [! meta.monad] + [ids (monad.all ! (list.repeated (list.size vars) meta.seed))] + (in (list (` (let [(~+ (|> vars + (list.zipped_2 ids) + (list#each (function (_ [id var]) + (list (code.local var) + (` (_.local (~ (code.text (format "v" (%.nat id))))))))) + list.together))] + (~ body)))))))) (def: module_id 0) @@ -102,54 +103,55 @@ ... (_.do "const_defined?" (list (_.string "Encoding")) {.#None})) ) -(syntax: (runtime: [declaration (<>.or <code>.local - (<code>.form (<>.and <code>.local - (<>.some <code>.local)))) - conditional_implementations (<>.some (<code>.tuple (<>.and <code>.any <code>.any))) - default_implementation <code>.any]) - (do meta.monad - [runtime_id meta.seed] - (macro.with_symbols [g!_] - (case declaration - {.#Left name} - (macro.with_symbols [g!_] - (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) - runtime_name (` (_.constant (~ (code.text (%.code runtime))))) - g!name (code.local name)] - (in (list (` (def: .public (~ g!name) _.CVar (~ runtime_name))) - (` (def: (~ (code.local (format "@" name))) - Statement - (~ (list#mix (function (_ [when then] else) - (` (_.if (~ when) - (_.set (list (~ runtime_name)) (~ then)) - (~ else)))) - (` (_.set (list (~ runtime_name)) (~ default_implementation))) - conditional_implementations)))))))) - - {.#Right [name inputs]} - (macro.with_symbols [g!_] - (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) - runtime_name (` (_.local (~ (code.text (%.code runtime))))) - g!name (code.local name) - inputsC (list#each code.local inputs) - inputs_typesC (list#each (function.constant (` _.Expression)) - inputs)] - (in (list (` (def: .public ((~ g!name) (~+ inputsC)) - (-> (~+ inputs_typesC) Computation) - (_.apply (list (~+ inputsC)) {.#None} - (~ runtime_name)))) - - (` (def: (~ (code.local (format "@" name))) - Statement - (..with_vars [(~+ inputsC)] +(def: runtime: + (syntax (_ [declaration (<>.or <code>.local + (<code>.form (<>.and <code>.local + (<>.some <code>.local)))) + conditional_implementations (<>.some (<code>.tuple (<>.and <code>.any <code>.any))) + default_implementation <code>.any]) + (do meta.monad + [runtime_id meta.seed] + (macro.with_symbols [g!_] + (case declaration + {.#Left name} + (macro.with_symbols [g!_] + (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) + runtime_name (` (_.constant (~ (code.text (%.code runtime))))) + g!name (code.local name)] + (in (list (` (def: .public (~ g!name) _.CVar (~ runtime_name))) + (` (def: (~ (code.local (format "@" name))) + Statement (~ (list#mix (function (_ [when then] else) (` (_.if (~ when) - (_.function (~ runtime_name) (list (~+ inputsC)) - (~ then)) + (_.set (list (~ runtime_name)) (~ then)) (~ else)))) - (` (_.function (~ runtime_name) (list (~+ inputsC)) - (~ default_implementation))) - conditional_implementations))))))))))))) + (` (_.set (list (~ runtime_name)) (~ default_implementation))) + conditional_implementations)))))))) + + {.#Right [name inputs]} + (macro.with_symbols [g!_] + (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) + runtime_name (` (_.local (~ (code.text (%.code runtime))))) + g!name (code.local name) + inputsC (list#each code.local inputs) + inputs_typesC (list#each (function.constant (` _.Expression)) + inputs)] + (in (list (` (def: .public ((~ g!name) (~+ inputsC)) + (-> (~+ inputs_typesC) Computation) + (_.apply (list (~+ inputsC)) {.#None} + (~ runtime_name)))) + + (` (def: (~ (code.local (format "@" name))) + Statement + (..with_vars [(~+ inputsC)] + (~ (list#mix (function (_ [when then] else) + (` (_.if (~ when) + (_.function (~ runtime_name) (list (~+ inputsC)) + (~ then)) + (~ else)))) + (` (_.function (~ runtime_name) (list (~+ inputsC)) + (~ default_implementation))) + conditional_implementations)))))))))))))) (def: tuple_size (_.the "length")) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux index f74911bc3..0de2a275a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux @@ -17,7 +17,7 @@ ["dict" dictionary (.only Dictionary)]]] ["[0]" macro (.only with_symbols) ["[0]" code] - [syntax (.only syntax:)]] + [syntax (.only syntax)]] [target ["_" scheme (.only Expression Computation)]]]] ["[0]" /// @@ -28,9 +28,10 @@ ["[1]/" // ["[1][0]" synthesis (.only Synthesis)]]]]) -(syntax: (Vector [size <code>.nat - elemT <code>.any]) - (in (list (` [(~+ (list.repeated size elemT))])))) +(def: Vector + (syntax (_ [size <code>.nat + elemT <code>.any]) + (in (list (` [(~+ (list.repeated size elemT))]))))) (type: .public Nullary (-> (Vector 0 Expression) Computation)) (type: .public Unary (-> (Vector 1 Expression) Computation)) @@ -38,26 +39,27 @@ (type: .public Trinary (-> (Vector 3 Expression) Computation)) (type: .public Variadic (-> (List Expression) Computation)) -(syntax: (arity: [name <code>.local - arity <code>.nat]) - (with_symbols [g!_ g!extension g!name g!phase g!inputs] - (do [! macro.monad] - [g!input+ (monad.all ! (list.repeated arity (macro.symbol "input")))] - (in (list (` (def: .public ((~ (code.local name)) (~ g!extension)) - (-> (-> (..Vector (~ (code.nat arity)) Expression) Computation) - Handler) - (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!inputs)) - (case (~ g!inputs) - (pattern (list (~+ g!input+))) - (do /////.monad - [(~+ (|> g!input+ - (list#each (function (_ g!input) - (list g!input (` ((~ g!phase) (~ g!input)))))) - list.together))] - ((~' in) ((~ g!extension) [(~+ g!input+)]))) - - (~' _) - (/////.except /////extension.incorrect_arity [(~ g!name) 1 (list.size (~ g!inputs))])))))))))) +(def: arity: + (syntax (_ [name <code>.local + arity <code>.nat]) + (with_symbols [g!_ g!extension g!name g!phase g!inputs] + (do [! macro.monad] + [g!input+ (monad.all ! (list.repeated arity (macro.symbol "input")))] + (in (list (` (def: .public ((~ (code.local name)) (~ g!extension)) + (-> (-> (..Vector (~ (code.nat arity)) Expression) Computation) + Handler) + (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!inputs)) + (case (~ g!inputs) + (pattern (list (~+ g!input+))) + (do /////.monad + [(~+ (|> g!input+ + (list#each (function (_ g!input) + (list g!input (` ((~ g!phase) (~ g!input)))))) + list.together))] + ((~' in) ((~ g!extension) [(~+ g!input+)]))) + + (~' _) + (/////.except /////extension.incorrect_arity [(~ g!name) 1 (list.size (~ g!inputs))]))))))))))) (arity: nullary 0) (arity: unary 1) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux index c147bf10a..63c9ae0ab 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux @@ -18,7 +18,7 @@ ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" sequence]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math [number (.only hex) @@ -58,52 +58,54 @@ (def: .public unit (_.string /////synthesis.unit)) -(syntax: .public (with_vars [vars (<code>.tuple (<>.some <code>.local)) - body <code>.any]) - (do [! meta.monad] - [ids (monad.all ! (list.repeated (list.size vars) meta.seed))] - (in (list (` (let [(~+ (|> vars - (list.zipped_2 ids) - (list#each (function (_ [id var]) - (list (code.local var) - (` (_.var (~ (code.text (format "v" (%.nat id))))))))) - list.together))] - (~ body))))))) - -(syntax: (runtime: [declaration (<>.or <code>.local - (<code>.form (<>.and <code>.local - (<>.some <code>.local)))) - code <code>.any]) - (do meta.monad - [runtime_id meta.seed] - (macro.with_symbols [g!_] - (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) - runtime_name (` (_.var (~ (code.text (%.code runtime)))))] - (case declaration - {.#Left name} - (let [g!name (code.local name)] - (in (list (` (def: .public (~ g!name) - Var - (~ runtime_name))) - - (` (def: (~ (code.local (format "@" name))) - _.Computation - (_.define_constant (~ runtime_name) (~ code))))))) - - {.#Right [name inputs]} - (let [g!name (code.local name) - inputsC (list#each code.local inputs) - inputs_typesC (list#each (function.constant (` _.Expression)) - inputs)] - (in (list (` (def: .public ((~ g!name) (~+ inputsC)) - (-> (~+ inputs_typesC) _.Computation) - (_.apply (list (~+ inputsC)) (~ runtime_name)))) - - (` (def: (~ (code.local (format "@" name))) - _.Computation - (..with_vars [(~+ inputsC)] - (_.define_function (~ runtime_name) [(list (~+ inputsC)) {.#None}] - (~ code))))))))))))) +(def: .public with_vars + (syntax (_ [vars (<code>.tuple (<>.some <code>.local)) + body <code>.any]) + (do [! meta.monad] + [ids (monad.all ! (list.repeated (list.size vars) meta.seed))] + (in (list (` (let [(~+ (|> vars + (list.zipped_2 ids) + (list#each (function (_ [id var]) + (list (code.local var) + (` (_.var (~ (code.text (format "v" (%.nat id))))))))) + list.together))] + (~ body)))))))) + +(def: runtime: + (syntax (_ [declaration (<>.or <code>.local + (<code>.form (<>.and <code>.local + (<>.some <code>.local)))) + code <code>.any]) + (do meta.monad + [runtime_id meta.seed] + (macro.with_symbols [g!_] + (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) + runtime_name (` (_.var (~ (code.text (%.code runtime)))))] + (case declaration + {.#Left name} + (let [g!name (code.local name)] + (in (list (` (def: .public (~ g!name) + Var + (~ runtime_name))) + + (` (def: (~ (code.local (format "@" name))) + _.Computation + (_.define_constant (~ runtime_name) (~ code))))))) + + {.#Right [name inputs]} + (let [g!name (code.local name) + inputsC (list#each code.local inputs) + inputs_typesC (list#each (function.constant (` _.Expression)) + inputs)] + (in (list (` (def: .public ((~ g!name) (~+ inputsC)) + (-> (~+ inputs_typesC) _.Computation) + (_.apply (list (~+ inputsC)) (~ runtime_name)))) + + (` (def: (~ (code.local (format "@" name))) + _.Computation + (..with_vars [(~+ inputsC)] + (_.define_function (~ runtime_name) [(list (~+ inputsC)) {.#None}] + (~ code)))))))))))))) (def: last_index (-> Expression Computation) diff --git a/stdlib/source/library/lux/type.lux b/stdlib/source/library/lux/type.lux index 8797ee80e..643b86923 100644 --- a/stdlib/source/library/lux/type.lux +++ b/stdlib/source/library/lux/type.lux @@ -18,7 +18,7 @@ ["[0]" array] ["[0]" list (.open: "[1]#[0]" monad monoid mix)]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["^" pattern] ["[0]" code]] [math @@ -382,57 +382,60 @@ product.left (n.> 0))) -(syntax: (new_secret_marker []) - (macro.with_symbols [g!_secret_marker_] - (in (list g!_secret_marker_)))) +(def: new_secret_marker + (syntax (_ []) + (macro.with_symbols [g!_secret_marker_] + (in (list g!_secret_marker_))))) (def: secret_marker (`` (symbol (~~ (new_secret_marker))))) -(syntax: .public (log! [input (<>.or (<>.and <code>.symbol - (<>.maybe (<>.after (<code>.this_symbol ..secret_marker) <code>.any))) - <code>.any)]) - (case input - {.#Left [valueN valueC]} - (do meta.monad - [location meta.location - valueT (meta.type valueN) - .let [_ ("lux io log" - (all text#composite - (symbol#encoded (symbol ..log!)) " " (location.format location) text.new_line - "Expression: " (case valueC - {.#Some valueC} - (code.format valueC) - - {.#None} - (symbol#encoded valueN)) - text.new_line - " Type: " (..format valueT)))]] - (in (list (code.symbol valueN)))) - - {.#Right valueC} - (macro.with_symbols [g!value] - (in (list (` (.let [(~ g!value) (~ valueC)] - (..log! (~ valueC) (~ (code.symbol ..secret_marker)) (~ g!value))))))))) +(def: .public log! + (syntax (_ [input (<>.or (<>.and <code>.symbol + (<>.maybe (<>.after (<code>.this_symbol ..secret_marker) <code>.any))) + <code>.any)]) + (case input + {.#Left [valueN valueC]} + (do meta.monad + [location meta.location + valueT (meta.type valueN) + .let [_ ("lux io log" + (all text#composite + (symbol#encoded (symbol ..log!)) " " (location.format location) text.new_line + "Expression: " (case valueC + {.#Some valueC} + (code.format valueC) + + {.#None} + (symbol#encoded valueN)) + text.new_line + " Type: " (..format valueT)))]] + (in (list (code.symbol valueN)))) + + {.#Right valueC} + (macro.with_symbols [g!value] + (in (list (` (.let [(~ g!value) (~ valueC)] + (..log! (~ valueC) (~ (code.symbol ..secret_marker)) (~ g!value)))))))))) (def: type_parameters (Parser (List Text)) (<code>.tuple (<>.some <code>.local))) -(syntax: .public (as [type_vars type_parameters - input <code>.any - output <code>.any - value (<>.maybe <code>.any)]) - (macro.with_symbols [g!_] - (.let [casterC (` (is (All ((~ g!_) (~+ (list#each code.local type_vars))) - (-> (~ input) (~ output))) - (|>> as_expected)))] - (case value - {.#None} - (in (list casterC)) - - {.#Some value} - (in (list (` ((~ casterC) (~ value))))))))) +(def: .public as + (syntax (_ [type_vars type_parameters + input <code>.any + output <code>.any + value (<>.maybe <code>.any)]) + (macro.with_symbols [g!_] + (.let [casterC (` (is (All ((~ g!_) (~+ (list#each code.local type_vars))) + (-> (~ input) (~ output))) + (|>> as_expected)))] + (case value + {.#None} + (in (list casterC)) + + {.#Some value} + (in (list (` ((~ casterC) (~ value)))))))))) (type: Typed (Record @@ -444,30 +447,32 @@ (<>.and <code>.any <code>.any)) ... TODO: Make sure the generated code always gets optimized away. -(syntax: .public (sharing [type_vars ..type_parameters - exemplar ..typed - computation ..typed]) - (macro.with_symbols [g!_] - (.let [typeC (` (All ((~ g!_) (~+ (list#each code.local type_vars))) - (-> (~ (the #type exemplar)) - (~ (the #type computation))))) - shareC (` (is (~ typeC) - (.function ((~ g!_) (~ g!_)) - (~ (the #expression computation)))))] - (in (list (` ((~ shareC) (~ (the #expression exemplar))))))))) - -(syntax: .public (by_example [type_vars ..type_parameters - exemplar ..typed - extraction <code>.any]) - (in (list (` (.type_of ((~! ..sharing) - [(~+ (list#each code.local type_vars))] - - (~ (the #type exemplar)) - (~ (the #expression exemplar)) - - (~ extraction) - ... The value of this expression will never be relevant, so it doesn't matter what it is. - (.as .Nothing []))))))) +(def: .public sharing + (syntax (_ [type_vars ..type_parameters + exemplar ..typed + computation ..typed]) + (macro.with_symbols [g!_] + (.let [typeC (` (All ((~ g!_) (~+ (list#each code.local type_vars))) + (-> (~ (the #type exemplar)) + (~ (the #type computation))))) + shareC (` (is (~ typeC) + (.function ((~ g!_) (~ g!_)) + (~ (the #expression computation)))))] + (in (list (` ((~ shareC) (~ (the #expression exemplar)))))))))) + +(def: .public by_example + (syntax (_ [type_vars ..type_parameters + exemplar ..typed + extraction <code>.any]) + (in (list (` (.type_of ((~! ..sharing) + [(~+ (list#each code.local type_vars))] + + (~ (the #type exemplar)) + (~ (the #expression exemplar)) + + (~ extraction) + ... The value of this expression will never be relevant, so it doesn't matter what it is. + (.as .Nothing [])))))))) (def: .public (replaced before after) (-> Type Type Type Type) @@ -498,10 +503,11 @@ {.#Named _}) it)))) -(syntax: .public (let [bindings (<code>.tuple (<>.some (<>.and <code>.any <code>.any))) - bodyT <code>.any]) - (in (list (` (..with_expansions [(~+ (|> bindings - (list#each (.function (_ [localT valueT]) - (list localT (` (.these (~ valueT)))))) - list#conjoint))] - (~ bodyT)))))) +(def: .public let + (syntax (_ [bindings (<code>.tuple (<>.some (<>.and <code>.any <code>.any))) + bodyT <code>.any]) + (in (list (` (..with_expansions [(~+ (|> bindings + (list#each (.function (_ [localT valueT]) + (list localT (` (.these (~ valueT)))))) + list#conjoint))] + (~ bodyT))))))) diff --git a/stdlib/source/library/lux/type/dynamic.lux b/stdlib/source/library/lux/type/dynamic.lux index 80bc06a84..d08962051 100644 --- a/stdlib/source/library/lux/type/dynamic.lux +++ b/stdlib/source/library/lux/type/dynamic.lux @@ -11,7 +11,7 @@ [text ["%" format]]] [macro (.only with_symbols) - ["[0]" syntax (.only syntax:)]] + ["[0]" syntax (.only syntax)]] ["[0]" type (.only) ["[0]" primitive (.only primitive:)]]]]) @@ -32,20 +32,22 @@ (-> Dynamic [Type Any]) (|>> primitive.representation)) - (syntax: .public (dynamic [value <code>.any]) - (with_symbols [g!value] - (in (list (` (.let [(~ g!value) (~ value)] - ((~! ..abstraction) [(.type_of (~ g!value)) (~ g!value)]))))))) + (def: .public dynamic + (syntax (_ [value <code>.any]) + (with_symbols [g!value] + (in (list (` (.let [(~ g!value) (~ value)] + ((~! ..abstraction) [(.type_of (~ g!value)) (~ g!value)])))))))) - (syntax: .public (static [type <code>.any - value <code>.any]) - (with_symbols [g!type g!value] - (in (list (` (.let [[(~ g!type) (~ g!value)] ((~! ..representation) (~ value))] - (.is ((~! try.Try) (~ type)) - (.if (.at (~! type.equivalence) (~' =) - (.type (~ type)) (~ g!type)) - {try.#Success (.as (~ type) (~ g!value))} - ((~! exception.except) ..wrong_type [(.type (~ type)) (~ g!type)]))))))))) + (def: .public static + (syntax (_ [type <code>.any + value <code>.any]) + (with_symbols [g!type g!value] + (in (list (` (.let [[(~ g!type) (~ g!value)] ((~! ..representation) (~ value))] + (.is ((~! try.Try) (~ type)) + (.if (.at (~! type.equivalence) (~' =) + (.type (~ type)) (~ g!type)) + {try.#Success (.as (~ type) (~ g!value))} + ((~! exception.except) ..wrong_type [(.type (~ type)) (~ g!type)])))))))))) (def: .public (format value) (-> Dynamic (Try Text)) diff --git a/stdlib/source/library/lux/type/implicit.lux b/stdlib/source/library/lux/type/implicit.lux index 95e9a53dc..b497be5d5 100644 --- a/stdlib/source/library/lux/type/implicit.lux +++ b/stdlib/source/library/lux/type/implicit.lux @@ -18,7 +18,7 @@ ["[0]" dictionary (.only Dictionary)]]] ["[0]" macro (.only) ["[0]" code] - [syntax (.only syntax:)]] + [syntax (.only syntax)]] [math ["[0]" number (.only) ["n" nat]]] @@ -334,40 +334,41 @@ _ (` ((~ (code.symbol constructor)) (~+ (list#each instance$ dependencies)))))) -(syntax: .public (a/an [member <code>.symbol - args (<>.or (<>.and (<>.some <code>.symbol) <code>.end) - (<>.and (<>.some <code>.any) <code>.end))]) - (case args - {.#Left [args _]} - (do [! meta.monad] - [[member_idx sig_type] (..implicit_member member) - input_types (monad.each ! ..implicit_type args) - output_type meta.expected_type - chosen_ones (alternatives sig_type member_idx input_types output_type)] - (case chosen_ones - {.#End} - (meta.failure (format "No implementation could be found for member: " (%.symbol member))) - - {.#Item chosen {.#End}} - (in (list (` (.at (~ (instance$ chosen)) - (~ (code.local (product.right member))) - (~+ (list#each code.symbol args)))))) - - _ - (meta.failure (format "Too many implementations available: " - (|> chosen_ones - (list#each (|>> product.left %.symbol)) - (text.interposed ", ")) - " --- for type: " (%.type sig_type))))) - - {.#Right [args _]} - (do [! meta.monad] - [labels (|> (macro.symbol "g!parameter") - (list.repeated (list.size args)) - (monad.all !))] - (in (list (` (let [(~+ (|> args (list.zipped_2 labels) (list#each ..pair_list) list#conjoint))] - (..a/an (~ (code.symbol member)) (~+ labels))))))) - )) +(def: .public a/an + (syntax (_ [member <code>.symbol + args (<>.or (<>.and (<>.some <code>.symbol) <code>.end) + (<>.and (<>.some <code>.any) <code>.end))]) + (case args + {.#Left [args _]} + (do [! meta.monad] + [[member_idx sig_type] (..implicit_member member) + input_types (monad.each ! ..implicit_type args) + output_type meta.expected_type + chosen_ones (alternatives sig_type member_idx input_types output_type)] + (case chosen_ones + {.#End} + (meta.failure (format "No implementation could be found for member: " (%.symbol member))) + + {.#Item chosen {.#End}} + (in (list (` (.at (~ (instance$ chosen)) + (~ (code.local (product.right member))) + (~+ (list#each code.symbol args)))))) + + _ + (meta.failure (format "Too many implementations available: " + (|> chosen_ones + (list#each (|>> product.left %.symbol)) + (text.interposed ", ")) + " --- for type: " (%.type sig_type))))) + + {.#Right [args _]} + (do [! meta.monad] + [labels (|> (macro.symbol "g!parameter") + (list.repeated (list.size args)) + (monad.all !))] + (in (list (` (let [(~+ (|> args (list.zipped_2 labels) (list#each ..pair_list) list#conjoint))] + (..a/an (~ (code.symbol member)) (~+ labels))))))) + ))) (def: .public a ..a/an) (def: .public an ..a/an) @@ -382,20 +383,22 @@ (Parser (List Code)) (<code>.tuple (<>.many <code>.any))) -(syntax: .public (with [implementations ..implicits - body <code>.any]) - (do meta.monad - [g!implicit+ (implicit_bindings (list.size implementations))] - (in (list (` (let [(~+ (|> (list.zipped_2 g!implicit+ implementations) - (list#each (function (_ [g!implicit implementation]) - (list g!implicit implementation))) - list#conjoint))] - (~ body))))))) - -(syntax: .public (implicit: [implementations ..implicits]) - (do meta.monad - [g!implicit+ (implicit_bindings (list.size implementations))] - (in (|> (list.zipped_2 g!implicit+ implementations) - (list#each (function (_ [g!implicit implementation]) - (` (def: .private (~ g!implicit) - (~ implementation))))))))) +(def: .public with + (syntax (_ [implementations ..implicits + body <code>.any]) + (do meta.monad + [g!implicit+ (implicit_bindings (list.size implementations))] + (in (list (` (let [(~+ (|> (list.zipped_2 g!implicit+ implementations) + (list#each (function (_ [g!implicit implementation]) + (list g!implicit implementation))) + list#conjoint))] + (~ body)))))))) + +(def: .public implicit: + (syntax (_ [implementations ..implicits]) + (do meta.monad + [g!implicit+ (implicit_bindings (list.size implementations))] + (in (|> (list.zipped_2 g!implicit+ implementations) + (list#each (function (_ [g!implicit implementation]) + (` (def: .private (~ g!implicit) + (~ implementation)))))))))) diff --git a/stdlib/source/library/lux/type/poly.lux b/stdlib/source/library/lux/type/poly.lux index cb18f9967..59d94e85f 100644 --- a/stdlib/source/library/lux/type/poly.lux +++ b/stdlib/source/library/lux/type/poly.lux @@ -17,7 +17,7 @@ ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" dictionary]]] [macro (.only with_symbols) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["^" pattern] ["[0]" code]] [math @@ -32,22 +32,24 @@ (<>.either (<>.and <code>.any private) (<>.and (<>#in (` .private)) private)))) -(syntax: .public (poly: [[export_policy name body] ..polyP]) - (with_symbols [g!_ g!type g!output] - (let [g!name (code.symbol ["" name])] - (in (.list (` ((~! syntax:) (~ export_policy) ((~ g!name) [(~ g!type) (~! <code>.any)]) - ((~! do) (~! meta.monad) - [(~ g!type) ((~! meta.eval) .Type (~ g!type))] - (case (is (.Either .Text .Code) - ((~! <type>.result) ((~! <>.rec) - (function ((~ g!_) (~ g!name)) - (~ body))) - (.as .Type (~ g!type)))) - {.#Left (~ g!output)} - ((~! meta.failure) (~ g!output)) +(def: .public poly: + (syntax (_ [[export_policy name body] ..polyP]) + (with_symbols [g!_ g!type g!output] + (let [g!name (code.symbol ["" name])] + (in (.list (` (def: (~ export_policy) (~ g!name) + ((~! syntax) ((~ g!name) [(~ g!type) (~! <code>.any)]) + ((~! do) (~! meta.monad) + [(~ g!type) ((~! meta.eval) .Type (~ g!type))] + (case (is (.Either .Text .Code) + ((~! <type>.result) ((~! <>.rec) + (function ((~ g!_) (~ g!name)) + (~ body))) + (.as .Type (~ g!type)))) + {.#Left (~ g!output)} + ((~! meta.failure) (~ g!output)) - {.#Right (~ g!output)} - ((~' in) (.list (~ g!output)))))))))))) + {.#Right (~ g!output)} + ((~' in) (.list (~ g!output)))))))))))))) (def: .public (code env type) (-> Env Type Code) diff --git a/stdlib/source/library/lux/type/primitive.lux b/stdlib/source/library/lux/type/primitive.lux index 601a35f9a..739afa0cd 100644 --- a/stdlib/source/library/lux/type/primitive.lux +++ b/stdlib/source/library/lux/type/primitive.lux @@ -15,7 +15,7 @@ [macro ["^" pattern] ["[0]" code] - [syntax (.only syntax:) + [syntax (.only syntax) ["|[0]|" export]]] [meta ["[0]" symbol (.open: "[1]#[0]" codec)]]]] @@ -172,12 +172,13 @@ (!push source module_reference (|> head (revised .#definitions (pop_frame_definition definition_reference))))) -(syntax: (pop! []) - (function (_ compiler) - {.#Right [(revised .#modules - (..pop_frame (symbol ..frames)) - compiler) - (list)]})) +(def: pop! + (syntax (_ []) + (function (_ compiler) + {.#Right [(revised .#modules + (..pop_frame (symbol ..frames)) + compiler) + (list)]}))) (def: cast (Parser [(Maybe Text) Code]) @@ -185,11 +186,12 @@ (<>.and (<>#in {.#None}) <code>.any))) (template [<name> <from> <to>] - [(syntax: .public (<name> [[frame value] ..cast]) - (do meta.monad - [[name type_vars abstraction representation] (peek! frame)] - (in (list (` ((~! //.as) [(~+ type_vars)] (~ <from>) (~ <to>) - (~ value)))))))] + [(def: .public <name> + (syntax (_ [[frame value] ..cast]) + (do meta.monad + [[name type_vars abstraction representation] (peek! frame)] + (in (list (` ((~! //.as) [(~+ type_vars)] (~ <from>) (~ <to>) + (~ value))))))))] [abstraction representation abstraction] [representation abstraction representation] @@ -221,26 +223,27 @@ ... TODO: Make sure the generated code always gets optimized away. ... (This applies to uses of "abstraction" and "representation") -(syntax: .public (primitive: [[export_policy [name type_vars] representation_type primitives] - ..abstract]) - (do meta.monad - [current_module meta.current_module_name - .let [type_varsC (list#each code.local type_vars) - abstraction_declaration (` ((~ (code.local name)) (~+ type_varsC))) - representation_declaration (` ((~ (code.local (representation_definition_name name))) - (~+ type_varsC)))] - _ (..push! [name - type_varsC - abstraction_declaration - representation_declaration])] - (in (partial_list (` (type: (~ export_policy) (~ abstraction_declaration) - (Primitive (~ (code.text (abstraction_type_name [current_module name]))) - [(~+ type_varsC)]))) - (` (type: (~ representation_declaration) - (~ representation_type))) - (all list#composite - primitives - (list (` ((~! ..pop!))))))))) +(def: .public primitive: + (syntax (_ [[export_policy [name type_vars] representation_type primitives] + ..abstract]) + (do meta.monad + [current_module meta.current_module_name + .let [type_varsC (list#each code.local type_vars) + abstraction_declaration (` ((~ (code.local name)) (~+ type_varsC))) + representation_declaration (` ((~ (code.local (representation_definition_name name))) + (~+ type_varsC)))] + _ (..push! [name + type_varsC + abstraction_declaration + representation_declaration])] + (in (partial_list (` (type: (~ export_policy) (~ abstraction_declaration) + (Primitive (~ (code.text (abstraction_type_name [current_module name]))) + [(~+ type_varsC)]))) + (` (type: (~ representation_declaration) + (~ representation_type))) + (all list#composite + primitives + (list (` ((~! ..pop!)))))))))) (type: (Selection a) (Variant @@ -252,12 +255,13 @@ (<>.or (<>.and <code>.any parser) parser)) -(syntax: .public (transmutation [selection (..selection <code>.any)]) - (case selection - {#Specific specific value} - (in (list (` (.|> (~ value) - (..representation (~ specific)) - (..abstraction (~ specific)))))) - - {#Current value} - (in (list (` (.|> (~ value) ..representation ..abstraction)))))) +(def: .public transmutation + (syntax (_ [selection (..selection <code>.any)]) + (case selection + {#Specific specific value} + (in (list (` (.|> (~ value) + (..representation (~ specific)) + (..abstraction (~ specific)))))) + + {#Current value} + (in (list (` (.|> (~ value) ..representation ..abstraction))))))) diff --git a/stdlib/source/library/lux/type/quotient.lux b/stdlib/source/library/lux/type/quotient.lux index f41618ae7..c9e37a60d 100644 --- a/stdlib/source/library/lux/type/quotient.lux +++ b/stdlib/source/library/lux/type/quotient.lux @@ -7,7 +7,7 @@ [parser ["<[0]>" code]]] [macro (.only with_symbols) - [syntax (.only syntax:)]] + [syntax (.only syntax)]] ["[0]" type [primitive (.except)]]]]) @@ -43,27 +43,28 @@ ) ) -(syntax: .public (type [class <code>.any]) - ... TODO: Switch to the cleaner approach ASAP. - (with_symbols [g!t g!c g!% g!_ g!:quotient:] - (in (list (` (let [... (~ g!_) (.is (.Ex ((~ g!_) (~ g!t) (~ g!c) (~ g!%)) - ... (..Class (~ g!t) (~ g!c) (~ g!%))) - ... (~ class)) - ] - (.case (.type_of (~ class)) - {.#Apply (~ g!%) {.#Apply (~ g!c) {.#Apply (~ g!t) (~ g!:quotient:)}}} - (.type (..Quotient (~ g!t) (~ g!c) (~ g!%))) +(def: .public type + (syntax (_ [class <code>.any]) + ... TODO: Switch to the cleaner approach ASAP. + (with_symbols [g!t g!c g!% g!_ g!:quotient:] + (in (list (` (let [ ... (~ g!_) (.is (.Ex ((~ g!_) (~ g!t) (~ g!c) (~ g!%)) + ... (..Class (~ g!t) (~ g!c) (~ g!%))) + ... (~ class)) + ] + (.case (.type_of (~ class)) + {.#Apply (~ g!%) {.#Apply (~ g!c) {.#Apply (~ g!t) (~ g!:quotient:)}}} + (.type (..Quotient (~ g!t) (~ g!c) (~ g!%))) - (~ g!_) - (.undefined)))) - ... (` ((~! type.by_example) - ... [(~ g!t) (~ g!c) (~ g!%)] + (~ g!_) + (.undefined)))) + ... (` ((~! type.by_example) + ... [(~ g!t) (~ g!c) (~ g!%)] - ... (..Class (~ g!t) (~ g!c) (~ g!%)) - ... (~ class) - - ... (..Quotient (~ g!t) (~ g!c) (~ g!%)))) - )))) + ... (..Class (~ g!t) (~ g!c) (~ g!%)) + ... (~ class) + + ... (..Quotient (~ g!t) (~ g!c) (~ g!%)))) + ))))) (implementation: .public (equivalence super) (All (_ t c %) (-> (Equivalence c) (Equivalence (..Quotient t c %)))) diff --git a/stdlib/source/library/lux/type/refinement.lux b/stdlib/source/library/lux/type/refinement.lux index 79860cfbc..fd571bc68 100644 --- a/stdlib/source/library/lux/type/refinement.lux +++ b/stdlib/source/library/lux/type/refinement.lux @@ -7,7 +7,7 @@ [parser ["<[0]>" code]]] ["[0]" macro (.only) - [syntax (.only syntax:)]] + [syntax (.only syntax)]] ["[0]" type (.only) [primitive (.except)]]]]) @@ -84,22 +84,23 @@ [yes {.#Item head no}])))) -(syntax: .public (type [refiner <code>.any]) - ... TODO: Switch to the cleaner approach ASAP. - (macro.with_symbols [g!t g!% g!_ g!:refiner:] - (in (list (` (let [... (~ g!_) (.is (.Ex ((~ g!_) (~ g!t) (~ g!%)) - ... (..Refined (~ g!t) (~ g!%))) - ... (~ refiner)) - ] - (.case (.type_of (~ refiner)) - {.#Apply (~ g!%) {.#Apply (~ g!t) (~ g!:refiner:)}} - (.type (..Refined (~ g!t) (~ g!%))) +(def: .public type + (syntax (_ [refiner <code>.any]) + ... TODO: Switch to the cleaner approach ASAP. + (macro.with_symbols [g!t g!% g!_ g!:refiner:] + (in (list (` (let [ ... (~ g!_) (.is (.Ex ((~ g!_) (~ g!t) (~ g!%)) + ... (..Refined (~ g!t) (~ g!%))) + ... (~ refiner)) + ] + (.case (.type_of (~ refiner)) + {.#Apply (~ g!%) {.#Apply (~ g!t) (~ g!:refiner:)}} + (.type (..Refined (~ g!t) (~ g!%))) - (~ g!_) - (.undefined)))) - ... (` ((~! type.by_example) [(~ g!t) (~ g!%)] - ... (..Refiner (~ g!t) (~ g!%)) - ... (~ refiner) - - ... (..Refined (~ g!t) (~ g!%)))) - )))) + (~ g!_) + (.undefined)))) + ... (` ((~! type.by_example) [(~ g!t) (~ g!%)] + ... (..Refiner (~ g!t) (~ g!%)) + ... (~ refiner) + + ... (..Refined (~ g!t) (~ g!%)))) + ))))) diff --git a/stdlib/source/library/lux/type/resource.lux b/stdlib/source/library/lux/type/resource.lux index 954715760..66556b724 100644 --- a/stdlib/source/library/lux/type/resource.lux +++ b/stdlib/source/library/lux/type/resource.lux @@ -18,7 +18,7 @@ ["[0]" sequence (.only Sequence)] ["[0]" list (.open: "[1]#[0]" functor mix)]]] ["[0]" macro (.only) - [syntax (.only syntax:)]] + [syntax (.only syntax)]] [math [number ["n" nat]]] @@ -126,35 +126,36 @@ (function (_ context) (at monad in [context []]))) -(syntax: .public (exchange [swaps ..indices]) - (macro.with_symbols [g!_ g!context g!!] - (case swaps - {.#End} - (in (list (` (~! no_op)))) - - {.#Item head tail} - (do [! meta.monad] - [.let [max_idx (list#mix n.max head tail)] - g!inputs (<| (monad.all !) (list.repeated (++ max_idx)) (macro.symbol "input")) - .let [g!outputs (|> (monad.mix maybe.monad - (function (_ from to) - (do maybe.monad - [input (list.item from g!inputs)] - (in (sequence.suffix input to)))) - (is (Sequence Code) sequence.empty) - swaps) - maybe.trusted - sequence.list) - g!inputsT+ (list#each (|>> (~) (..Key ..Commutative) (`)) g!inputs) - g!outputsT+ (list#each (|>> (~) (..Key ..Commutative) (`)) g!outputs)]] - (in (list (` (is (All ((~ g!_) (~ g!!) (~+ g!inputs) (~ g!context)) - (-> ((~! monad.Monad) (~ g!!)) - (Procedure (~ g!!) - [(~+ g!inputsT+) (~ g!context)] - [(~+ g!outputsT+) (~ g!context)] - .Any))) - (function ((~ g!_) (~ g!!) [(~+ g!inputs) (~ g!context)]) - (at (~ g!!) (~' in) [[(~+ g!outputs) (~ g!context)] []])))))))))) +(def: .public exchange + (syntax (_ [swaps ..indices]) + (macro.with_symbols [g!_ g!context g!!] + (case swaps + {.#End} + (in (list (` (~! no_op)))) + + {.#Item head tail} + (do [! meta.monad] + [.let [max_idx (list#mix n.max head tail)] + g!inputs (<| (monad.all !) (list.repeated (++ max_idx)) (macro.symbol "input")) + .let [g!outputs (|> (monad.mix maybe.monad + (function (_ from to) + (do maybe.monad + [input (list.item from g!inputs)] + (in (sequence.suffix input to)))) + (is (Sequence Code) sequence.empty) + swaps) + maybe.trusted + sequence.list) + g!inputsT+ (list#each (|>> (~) (..Key ..Commutative) (`)) g!inputs) + g!outputsT+ (list#each (|>> (~) (..Key ..Commutative) (`)) g!outputs)]] + (in (list (` (is (All ((~ g!_) (~ g!!) (~+ g!inputs) (~ g!context)) + (-> ((~! monad.Monad) (~ g!!)) + (Procedure (~ g!!) + [(~+ g!inputsT+) (~ g!context)] + [(~+ g!outputsT+) (~ g!context)] + .Any))) + (function ((~ g!_) (~ g!!) [(~+ g!inputs) (~ g!context)]) + (at (~ g!!) (~' in) [[(~+ g!outputs) (~ g!context)] []]))))))))))) (def: amount (Parser Nat) @@ -165,20 +166,21 @@ (in raw))) (template [<name> <from> <to>] - [(syntax: .public (<name> [amount ..amount]) - (macro.with_symbols [g!_ g!context g!!] - (do [! meta.monad] - [g!keys (|> (macro.symbol "keys") - (list.repeated amount) - (monad.all !))] - (in (list (` (is (All ((~ g!_) (~ g!!) (~+ g!keys) (~ g!context)) - (-> ((~! monad.Monad) (~ g!!)) - (Procedure (~ g!!) - [<from> (~ g!context)] - [<to> (~ g!context)] - .Any))) - (function ((~ g!_) (~ g!!) [<from> (~ g!context)]) - (at (~ g!!) (~' in) [[<to> (~ g!context)] []])))))))))] + [(def: .public <name> + (syntax (_ [amount ..amount]) + (macro.with_symbols [g!_ g!context g!!] + (do [! meta.monad] + [g!keys (|> (macro.symbol "keys") + (list.repeated amount) + (monad.all !))] + (in (list (` (is (All ((~ g!_) (~ g!!) (~+ g!keys) (~ g!context)) + (-> ((~! monad.Monad) (~ g!!)) + (Procedure (~ g!!) + [<from> (~ g!context)] + [<to> (~ g!context)] + .Any))) + (function ((~ g!_) (~ g!!) [<from> (~ g!context)]) + (at (~ g!!) (~' in) [[<to> (~ g!context)] []]))))))))))] [group (~+ g!keys) [(~+ g!keys)]] [un_group [(~+ g!keys)] (~+ g!keys)] diff --git a/stdlib/source/library/lux/type/unit.lux b/stdlib/source/library/lux/type/unit.lux index 6fb069d56..2b31de229 100644 --- a/stdlib/source/library/lux/type/unit.lux +++ b/stdlib/source/library/lux/type/unit.lux @@ -16,7 +16,7 @@ [macro ["[0]" code] ["[0]" template] - [syntax (.only syntax:) + [syntax (.only syntax) ["|[0]|" export]]] [math [number @@ -85,23 +85,24 @@ (-> Pure Int) ..out') -(syntax: .public (unit: [[export_policy type_name unit_name] - (|export|.parser - (all <>.and - <code>.local - <code>.local))]) - (do meta.monad - [@ meta.current_module_name - .let [g!type (code.local type_name)]] - (in (list (` (type: (~ export_policy) (~ g!type) - (Primitive (~ (code.text (%.symbol [@ type_name])))))) - - (` (implementation: (~ export_policy) (~ (code.local unit_name)) - (..Unit (~ g!type)) - - (def: (~' in) (~! ..in')) - (def: (~' out) (~! ..out')))) - )))) +(def: .public unit: + (syntax (_ [[export_policy type_name unit_name] + (|export|.parser + (all <>.and + <code>.local + <code>.local))]) + (do meta.monad + [@ meta.current_module_name + .let [g!type (code.local type_name)]] + (in (list (` (type: (~ export_policy) (~ g!type) + (Primitive (~ (code.text (%.symbol [@ type_name])))))) + + (` (implementation: (~ export_policy) (~ (code.local unit_name)) + (..Unit (~ g!type)) + + (def: (~' in) (~! ..in')) + (def: (~' out) (~! ..out')))) + ))))) (def: scaleP (Parser Ratio) @@ -114,36 +115,37 @@ (n.> 0 denominator))] (in [numerator denominator])))) -(syntax: .public (scale: [[export_policy type_name scale_name ratio] - (|export|.parser - (all <>.and - <code>.local - <code>.local - ..scaleP))]) - (do meta.monad - [.let [(open "_[0]") ratio] - @ meta.current_module_name - .let [g!scale (code.local type_name)]] - (in (list (` (type: (~ export_policy) ((~ g!scale) (~' u)) - (Primitive (~ (code.text (%.symbol [@ type_name]))) [(~' u)]))) - - (` (implementation: (~ export_policy) (~ (code.local scale_name)) - (..Scale (~ g!scale)) - - (def: (~' scale) - (|>> ((~! ..out')) - (i.* (~ (code.int (.int _#numerator)))) - (i./ (~ (code.int (.int _#denominator)))) - ((~! ..in')))) - (def: (~' de_scale) - (|>> ((~! ..out')) - (i.* (~ (code.int (.int _#denominator)))) - (i./ (~ (code.int (.int _#numerator)))) - ((~! ..in')))) - (def: (~' ratio) - [(~ (code.nat _#numerator)) - (~ (code.nat _#denominator))]))) - )))) +(def: .public scale: + (syntax (_ [[export_policy type_name scale_name ratio] + (|export|.parser + (all <>.and + <code>.local + <code>.local + ..scaleP))]) + (do meta.monad + [.let [(open "_[0]") ratio] + @ meta.current_module_name + .let [g!scale (code.local type_name)]] + (in (list (` (type: (~ export_policy) ((~ g!scale) (~' u)) + (Primitive (~ (code.text (%.symbol [@ type_name]))) [(~' u)]))) + + (` (implementation: (~ export_policy) (~ (code.local scale_name)) + (..Scale (~ g!scale)) + + (def: (~' scale) + (|>> ((~! ..out')) + (i.* (~ (code.int (.int _#numerator)))) + (i./ (~ (code.int (.int _#denominator)))) + ((~! ..in')))) + (def: (~' de_scale) + (|>> ((~! ..out')) + (i.* (~ (code.int (.int _#denominator)))) + (i./ (~ (code.int (.int _#numerator)))) + ((~! ..in')))) + (def: (~' ratio) + [(~ (code.nat _#numerator)) + (~ (code.nat _#denominator))]))) + ))))) (def: .public (re_scaled from to quantity) (All (_ si so u) (-> (Scale si) (Scale so) (Qty (si u)) (Qty (so u)))) @@ -155,8 +157,9 @@ (i./ (.int denominator)) in'))) -(syntax: (implementation_name [type_name <code>.local]) - (in (list (code.local (text.lower_cased type_name))))) +(def: implementation_name + (syntax (_ [type_name <code>.local]) + (in (list (code.local (text.lower_cased type_name)))))) (template [<type> <from> <to>] [(`` (scale: .public <type> diff --git a/stdlib/source/library/lux/world/net/http/client.lux b/stdlib/source/library/lux/world/net/http/client.lux index 447537f95..b424265f2 100644 --- a/stdlib/source/library/lux/world/net/http/client.lux +++ b/stdlib/source/library/lux/world/net/http/client.lux @@ -20,7 +20,7 @@ [collection ["[0]" dictionary]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code] ["[0]" template]] [math @@ -36,8 +36,9 @@ (! (Try (//.Response !)))) request))) -(syntax: (method_function [[_ name] <code>.symbol]) - (in (list (code.local (text.replaced "#" "" (text.lower_cased name)))))) +(def: method_function + (syntax (_ [[_ name] <code>.symbol]) + (in (list (code.local (text.replaced "#" "" (text.lower_cased name))))))) (template [<method>] [(with_expansions [<name> (method_function <method>)] diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux index 207e94fc0..97a89845e 100644 --- a/stdlib/source/poly/lux/abstract/equivalence.lux +++ b/stdlib/source/poly/lux/abstract/equivalence.lux @@ -21,7 +21,6 @@ ["[0]" dictionary (.only Dictionary)] ["[0]" tree]]] [macro - [syntax (.only syntax:)] ["[0]" code]] [math [number diff --git a/stdlib/source/poly/lux/abstract/functor.lux b/stdlib/source/poly/lux/abstract/functor.lux index f7a4a6d7d..310c3ff9a 100644 --- a/stdlib/source/poly/lux/abstract/functor.lux +++ b/stdlib/source/poly/lux/abstract/functor.lux @@ -14,7 +14,6 @@ [collection ["[0]" list (.open: "[1]#[0]" monad monoid)]]] [macro - [syntax (.only syntax:)] ["[0]" code]] [math [number diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index a10f632d8..71bd8cea4 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -19,7 +19,7 @@ ["[0]" sequence (.only sequence)] ["[0]" dictionary]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math [number @@ -324,11 +324,12 @@ (<>.failure (format "Cannot create JSON decoder for: " (type.format inputT))) )))) -(syntax: .public (codec [inputT <code>.any]) - (in (.list (` (is (codec.Codec /.JSON (~ inputT)) - (implementation - (def: (~' encoded) - ((~! ..encoded) (~ inputT))) - (def: (~' decoded) - ((~! </>.result) ((~! ..decoded) (~ inputT)))) - )))))) +(def: .public codec + (syntax (_ [inputT <code>.any]) + (in (.list (` (is (codec.Codec /.JSON (~ inputT)) + (implementation + (def: (~' encoded) + ((~! ..encoded) (~ inputT))) + (def: (~' decoded) + ((~! </>.result) ((~! ..decoded) (~ inputT)))) + ))))))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index d83a447f5..056d93079 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -25,7 +25,7 @@ [dictionary ["[0]" plist]]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["^" pattern] ["[0]" code (.open: "[1]#[0]" equivalence)] ["[0]" template]] @@ -1055,26 +1055,28 @@ @.python @.ruby))) -(syntax: (for_meta|Info []) - (function (_ lux) - (let [info (the .#info lux) - - conforming_target! - (set.member? ..possible_targets (the .#target info)) - - compiling! - (case (the .#mode info) - {.#Build} true - _ false)] - {.#Right [lux (list (code.bit (and conforming_target! - compiling!)))]}))) - -(syntax: (for_meta|Module_State []) - (do meta.monad - [prelude_module (meta.module .prelude_module)] - (in (list (code.bit (case (the .#module_state prelude_module) - {.#Active} false - _ true)))))) +(def: for_meta|Info + (syntax (_ []) + (function (_ lux) + (let [info (the .#info lux) + + conforming_target! + (set.member? ..possible_targets (the .#target info)) + + compiling! + (case (the .#mode info) + {.#Build} true + _ false)] + {.#Right [lux (list (code.bit (and conforming_target! + compiling!)))]})))) + +(def: for_meta|Module_State + (syntax (_ []) + (do meta.monad + [prelude_module (meta.module .prelude_module)] + (in (list (code.bit (case (the .#module_state prelude_module) + {.#Active} false + _ true))))))) (def: for_meta Test @@ -1096,65 +1098,66 @@ )) (for @.old (these) - (these (syntax: (for_bindings|test lux_state - [fn/0 <code>.local - var/0 <code>.local - let/0 <code>.local - - fn/1 <code>.local - var/1 <code>.local - let/1 <code>.local - - fn/2 <code>.local - var/2 <code>.local - let/2 <code>.local - - let/3 <code>.local]) - (in (list (code.bit (case (the .#scopes lux_state) - (pattern (partial_list scope/2 _)) - (let [locals/2 (the .#locals scope/2) - expected_locals/2 (set.of_list text.hash (list fn/2 var/2 let/2 - let/3)) - actual_locals/2 (|> locals/2 - (the .#mappings) - (list#each product.left) - (set.of_list text.hash)) - - correct_locals! - (and (n.= 4 (the .#counter locals/2)) - (set#= expected_locals/2 - actual_locals/2)) - - captured/2 (the .#captured scope/2) - - local? (is (-> Ref Bit) - (function (_ ref) - (case ref - {.#Local _} true - {.#Captured _} false))) - captured? (is (-> Ref Bit) - (|>> local? not)) - binding? (is (-> (-> Ref Bit) Text Bit) - (function (_ is? name) - (|> captured/2 - (the .#mappings) - (plist.value name) - (maybe#each (|>> product.right is?)) - (maybe.else false)))) - - correct_closure! - (and (n.= 6 (the .#counter captured/2)) - (binding? local? fn/1) - (binding? local? var/1) - (binding? local? let/1) - (binding? captured? fn/0) - (binding? captured? var/0) - (binding? captured? let/0))] - (and correct_locals! - correct_closure!)) - - _ - false))))) + (these (def: for_bindings|test + (syntax (_ lux_state + [fn/0 <code>.local + var/0 <code>.local + let/0 <code>.local + + fn/1 <code>.local + var/1 <code>.local + let/1 <code>.local + + fn/2 <code>.local + var/2 <code>.local + let/2 <code>.local + + let/3 <code>.local]) + (in (list (code.bit (case (the .#scopes lux_state) + (pattern (partial_list scope/2 _)) + (let [locals/2 (the .#locals scope/2) + expected_locals/2 (set.of_list text.hash (list fn/2 var/2 let/2 + let/3)) + actual_locals/2 (|> locals/2 + (the .#mappings) + (list#each product.left) + (set.of_list text.hash)) + + correct_locals! + (and (n.= 4 (the .#counter locals/2)) + (set#= expected_locals/2 + actual_locals/2)) + + captured/2 (the .#captured scope/2) + + local? (is (-> Ref Bit) + (function (_ ref) + (case ref + {.#Local _} true + {.#Captured _} false))) + captured? (is (-> Ref Bit) + (|>> local? not)) + binding? (is (-> (-> Ref Bit) Text Bit) + (function (_ is? name) + (|> captured/2 + (the .#mappings) + (plist.value name) + (maybe#each (|>> product.right is?)) + (maybe.else false)))) + + correct_closure! + (and (n.= 6 (the .#counter captured/2)) + (binding? local? fn/1) + (binding? local? var/1) + (binding? local? let/1) + (binding? captured? fn/0) + (binding? captured? var/0) + (binding? captured? let/0))] + (and correct_locals! + correct_closure!)) + + _ + false)))))) (def: for_bindings Test diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index c0f1d05f6..656c8b988 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -23,7 +23,7 @@ [number ["n" nat]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]]]] [\\library ["[0]" / (.only Parser)]] @@ -76,15 +76,16 @@ _ #0)) -(syntax: (match [pattern <code>.any - then <code>.any - input <code>.any]) - (in (list (` (case (~ input) - (pattern {try.#Success [(~' _) (~ pattern)]}) - (~ then) +(def: match + (syntax (_ [pattern <code>.any + then <code>.any + input <code>.any]) + (in (list (` (case (~ input) + (pattern {try.#Success [(~' _) (~ pattern)]}) + (~ then) - (~' _) - #0))))) + (~' _) + #0)))))) (def: combinators_0 Test diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux index 38bd18517..090810aab 100644 --- a/stdlib/source/test/lux/control/remember.lux +++ b/stdlib/source/test/lux/control/remember.lux @@ -24,7 +24,7 @@ ["[0]" duration]] ["[0]" macro (.only) ["[0]" code] - ["[0]" syntax (.only syntax:)]]]] + ["[0]" syntax (.only syntax)]]]] [\\library ["[0]" /]]) @@ -62,48 +62,49 @@ {.#Some focus} (text.contains? (%.code focus) failure)))) -(syntax: (test_macro [macro <code>.symbol - extra <code>.text]) - (let [now (io.run! instant.now) - today (instant.date now) - yesterday (instant.date (instant.after (duration.inverse duration.week) now)) - tomorrow (instant.date (instant.after duration.week now)) - prng (random.pcg_32 [(hex "0123456789ABCDEF") - (instant.millis now)]) - message (product.right (random.result prng ..message)) - expected (product.right (random.result prng ..focus))] - (do meta.monad - [should_fail0 (..attempt (macro.expansion (..memory macro yesterday message {.#None}))) - should_fail1 (..attempt (macro.expansion (..memory macro yesterday message {.#Some expected}))) - should_succeed0 (..attempt (macro.expansion (..memory macro tomorrow message {.#None}))) - should_succeed1 (..attempt (macro.expansion (..memory macro tomorrow message {.#Some expected})))] - (in (list (code.bit (and (case should_fail0 - {try.#Failure error} - (and (test_failure yesterday message {.#None} error) - (text.contains? extra error)) +(def: test_macro + (syntax (_ [macro <code>.symbol + extra <code>.text]) + (let [now (io.run! instant.now) + today (instant.date now) + yesterday (instant.date (instant.after (duration.inverse duration.week) now)) + tomorrow (instant.date (instant.after duration.week now)) + prng (random.pcg_32 [(hex "0123456789ABCDEF") + (instant.millis now)]) + message (product.right (random.result prng ..message)) + expected (product.right (random.result prng ..focus))] + (do meta.monad + [should_fail0 (..attempt (macro.expansion (..memory macro yesterday message {.#None}))) + should_fail1 (..attempt (macro.expansion (..memory macro yesterday message {.#Some expected}))) + should_succeed0 (..attempt (macro.expansion (..memory macro tomorrow message {.#None}))) + should_succeed1 (..attempt (macro.expansion (..memory macro tomorrow message {.#Some expected})))] + (in (list (code.bit (and (case should_fail0 + {try.#Failure error} + (and (test_failure yesterday message {.#None} error) + (text.contains? extra error)) - _ - false) - (case should_fail1 - {try.#Failure error} - (and (test_failure yesterday message {.#Some expected} error) - (text.contains? extra error)) + _ + false) + (case should_fail1 + {try.#Failure error} + (and (test_failure yesterday message {.#Some expected} error) + (text.contains? extra error)) - _ - false) - (case should_succeed0 - (pattern {try.#Success (list)}) - true + _ + false) + (case should_succeed0 + (pattern {try.#Success (list)}) + true - _ - false) - (case should_succeed1 - (pattern {try.#Success (list actual)}) - (same? expected actual) + _ + false) + (case should_succeed1 + (pattern {try.#Success (list actual)}) + (same? expected actual) - _ - false) - ))))))) + _ + false) + )))))))) (def: .public test Test diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index c0d9f7537..a4874021b 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -26,7 +26,7 @@ ["n" nat] ["[0]" frac]]] ["[0]" macro (.only) - ["[0]" syntax (.only syntax:)] + ["[0]" syntax (.only syntax)] ["[0]" code]]]] [\\library ["[0]" / (.only JSON) (.open: "[1]#[0]" equivalence)]]) @@ -46,20 +46,23 @@ (random.dictionary text.hash size (random.unicode size) again) ))))) -(syntax: (boolean []) - (do meta.monad - [value meta.seed] - (in (list (code.bit (n.even? value)))))) +(def: boolean + (syntax (_ []) + (do meta.monad + [value meta.seed] + (in (list (code.bit (n.even? value))))))) -(syntax: (number []) - (do meta.monad - [value meta.seed] - (in (list (code.frac (n.frac value)))))) +(def: number + (syntax (_ []) + (do meta.monad + [value meta.seed] + (in (list (code.frac (n.frac value))))))) -(syntax: (string []) - (do meta.monad - [value (macro.symbol "string")] - (in (list (code.text (%.code value)))))) +(def: string + (syntax (_ []) + (do meta.monad + [value (macro.symbol "string")] + (in (list (code.text (%.code value))))))) (def: .public test Test diff --git a/stdlib/source/test/lux/data/text/escape.lux b/stdlib/source/test/lux/data/text/escape.lux index d1258bf25..8a897d348 100644 --- a/stdlib/source/test/lux/data/text/escape.lux +++ b/stdlib/source/test/lux/data/text/escape.lux @@ -18,7 +18,7 @@ [collection ["[0]" set (.only Set)]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code] ["[0]" template]] [math @@ -69,16 +69,18 @@ (debug.private /.\\_sigil) (debug.private /.\u_sigil)))) -(syntax: (static_sample []) - (do meta.monad - [seed meta.seed - .let [[_ expected] (|> (random.ascii 10) - (random.only (|>> (text.contains? text.\0) not)) - (random.result (random.pcg_32 [seed seed])))]] - (in (list (code.text expected))))) +(def: static_sample + (syntax (_ []) + (do meta.monad + [seed meta.seed + .let [[_ expected] (|> (random.ascii 10) + (random.only (|>> (text.contains? text.\0) not)) + (random.result (random.pcg_32 [seed seed])))]] + (in (list (code.text expected)))))) -(syntax: (static_escaped [un_escaped <code>.text]) - (in (list (code.text (/.escaped un_escaped))))) +(def: static_escaped + (syntax (_ [un_escaped <code>.text]) + (in (list (code.text (/.escaped un_escaped)))))) (def: .public test Test diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index c16388e4e..43a34d694 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -14,7 +14,7 @@ ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math [number (.only hex)] @@ -55,18 +55,19 @@ _ false))) -(syntax: (should_check [pattern <code>.any - regex <code>.any - input <code>.any]) - (macro.with_symbols [g!message g!_] - (in (list (` (|> (~ input) - (<text>.result (~ regex)) - (pipe.case - (pattern {try.#Success (~ pattern)}) - true +(def: should_check + (syntax (_ [pattern <code>.any + regex <code>.any + input <code>.any]) + (macro.with_symbols [g!message g!_] + (in (list (` (|> (~ input) + (<text>.result (~ regex)) + (pipe.case + (pattern {try.#Success (~ pattern)}) + true - (~ g!_) - false))))))) + (~ g!_) + false)))))))) (def: basics Test @@ -276,14 +277,15 @@ "123-456-7890"))) )) -(syntax: (expands? [form <code>.any]) - (function (_ lux) - {try.#Success [lux (list (code.bit (case (macro.single_expansion form lux) - {try.#Success _} - true +(def: expands? + (syntax (_ [form <code>.any]) + (function (_ lux) + {try.#Success [lux (list (code.bit (case (macro.single_expansion form lux) + {try.#Success _} + true - {try.#Failure error} - false)))]})) + {try.#Failure error} + false)))]}))) (def: .public test Test diff --git a/stdlib/source/test/lux/debug.lux b/stdlib/source/test/lux/debug.lux index 9b61ab55d..bfa275ce7 100644 --- a/stdlib/source/test/lux/debug.lux +++ b/stdlib/source/test/lux/debug.lux @@ -19,7 +19,7 @@ [json (.only JSON)] [xml (.only XML)]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math ["[0]" random (.only Random)] @@ -216,14 +216,15 @@ (/.inspection [sample_bit sample_int sample_frac sample_text])) ))))) -(syntax: (macro_error [macro <code>.any]) - (function (_ compiler) - (case ((macro.expansion macro) compiler) - {try.#Failure error} - {try.#Success [compiler (list (code.text error))]} - - {try.#Success _} - {try.#Failure "OOPS!"}))) +(def: macro_error + (syntax (_ [macro <code>.any]) + (function (_ compiler) + (case ((macro.expansion macro) compiler) + {try.#Failure error} + {try.#Success [compiler (list (code.text error))]} + + {try.#Success _} + {try.#Failure "OOPS!"})))) (type: My_Text Text) diff --git a/stdlib/source/test/lux/documentation.lux b/stdlib/source/test/lux/documentation.lux index 92248d84c..3052034b4 100644 --- a/stdlib/source/test/lux/documentation.lux +++ b/stdlib/source/test/lux/documentation.lux @@ -14,25 +14,27 @@ [format ["md" markdown]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" template] ["[0]" code]]]] [\\library ["[0]" /]]) -(syntax: (macro_error [macro <code>.any]) - (function (_ compiler) - {try.#Success [compiler (list (code.bit (case ((macro.expansion macro) compiler) - {try.#Failure error} - true - - {try.#Success _} - false)))]})) +(def: macro_error + (syntax (_ [macro <code>.any]) + (function (_ compiler) + {try.#Success [compiler (list (code.bit (case ((macro.expansion macro) compiler) + {try.#Failure error} + true + + {try.#Success _} + false)))]}))) -(syntax: (description []) - (at meta.monad each - (|>> %.nat code.text list) - meta.seed)) +(def: description + (syntax (_ []) + (at meta.monad each + (|>> %.nat code.text list) + meta.seed))) (template.with_locals [g!default] (with_expansions ['definition_description' (..description) diff --git a/stdlib/source/test/lux/ffi.jvm.lux b/stdlib/source/test/lux/ffi.jvm.lux index 4a25f246e..3a6df69db 100644 --- a/stdlib/source/test/lux/ffi.jvm.lux +++ b/stdlib/source/test/lux/ffi.jvm.lux @@ -21,7 +21,7 @@ [collection ["[0]" array (.only Array)]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code] ["[0]" template]] [math @@ -71,16 +71,17 @@ [character#= /.Character /.char_to_long Int i#=] ) -(syntax: (macro_error [expression <code>.any]) - (function (_ lux) - (|> (macro.single_expansion expression) - (meta.result lux) - (pipe.case - {try.#Success expansion} - {try.#Failure "OOPS!"} - - {try.#Failure error} - {try.#Success [lux (list (code.text error))]})))) +(def: macro_error + (syntax (_ [expression <code>.any]) + (function (_ lux) + (|> (macro.single_expansion expression) + (meta.result lux) + (pipe.case + {try.#Success expansion} + {try.#Failure "OOPS!"} + + {try.#Failure error} + {try.#Success [lux (list (code.text error))]}))))) (def: for_conversions Test @@ -614,20 +615,21 @@ example/9!) ))) -(syntax: (expands? [expression <code>.any]) - (function (_ lux) - (|> (macro.single_expansion expression) - (meta.result lux) - (pipe.case - {try.#Success expansion} - true - - {try.#Failure error} - false) - code.bit - list - [lux] - {try.#Success}))) +(def: expands? + (syntax (_ [expression <code>.any]) + (function (_ lux) + (|> (macro.single_expansion expression) + (meta.result lux) + (pipe.case + {try.#Success expansion} + true + + {try.#Failure error} + false) + code.bit + list + [lux] + {try.#Success})))) (def: for_exception Test diff --git a/stdlib/source/test/lux/ffi/export.js.lux b/stdlib/source/test/lux/ffi/export.js.lux index 913fe5d5e..37402fc3b 100644 --- a/stdlib/source/test/lux/ffi/export.js.lux +++ b/stdlib/source/test/lux/ffi/export.js.lux @@ -11,7 +11,7 @@ ["/[1]" //]]]) (with_expansions [<nat> (static.random_nat)] - (/.export: + (/.export (def: constant Nat <nat>) @@ -26,7 +26,7 @@ Test (<| (_.covering /._) (all _.and - (_.coverage [/.export:] + (_.coverage [/.export] (and (n.= <nat> ..constant) (n.= (n.+ <nat> <nat>) (..shift <nat>)))) ))) diff --git a/stdlib/source/test/lux/ffi/export.jvm.lux b/stdlib/source/test/lux/ffi/export.jvm.lux index 805e01c28..3ad692d50 100644 --- a/stdlib/source/test/lux/ffi/export.jvm.lux +++ b/stdlib/source/test/lux/ffi/export.jvm.lux @@ -34,7 +34,7 @@ (def: expected_double (//.as_double (static.random_frac))) (def: expected_string (//.as_string (static.random code.text (random.lower_case 2)))) -(`` (`` (/.export: Primitives +(`` (`` (/.export Primitives ... Constants (actual_boolean boolean ..expected_boolean) (actual_byte byte ..expected_byte) @@ -91,7 +91,7 @@ )) ))) -(/.export: Objects +(/.export Objects (actual_string java/lang/String ..expected_string) ((string_method [left java/lang/String right java/lang/String]) @@ -141,7 +141,7 @@ [string //.as_string (random.lower_case 1)] ))] (all _.and - (_.coverage [/.export:] + (_.coverage [/.export] (and (bit#= (//.of_boolean ..expected_boolean) (//.of_boolean (Primitives::actual_boolean))) (int#= (//.of_byte ..expected_byte) (//.of_byte (Primitives::actual_byte))) (int#= (//.of_short ..expected_short) (//.of_short (Primitives::actual_short))) diff --git a/stdlib/source/test/lux/ffi/export.lua.lux b/stdlib/source/test/lux/ffi/export.lua.lux index d253d7329..f3c9b90ea 100644 --- a/stdlib/source/test/lux/ffi/export.lua.lux +++ b/stdlib/source/test/lux/ffi/export.lua.lux @@ -11,7 +11,7 @@ ["/[1]" //]]]) (with_expansions [<nat> (static.random_nat)] - (/.export: + (/.export (def: constant Nat <nat>) @@ -26,7 +26,7 @@ Test (<| (_.covering /._) (all _.and - (_.coverage [/.export:] + (_.coverage [/.export] (and (n.= <nat> (..constant)) (n.= (n.+ <nat> <nat>) ((..shift) <nat>)))) ))) diff --git a/stdlib/source/test/lux/ffi/export.py.lux b/stdlib/source/test/lux/ffi/export.py.lux index 913fe5d5e..37402fc3b 100644 --- a/stdlib/source/test/lux/ffi/export.py.lux +++ b/stdlib/source/test/lux/ffi/export.py.lux @@ -11,7 +11,7 @@ ["/[1]" //]]]) (with_expansions [<nat> (static.random_nat)] - (/.export: + (/.export (def: constant Nat <nat>) @@ -26,7 +26,7 @@ Test (<| (_.covering /._) (all _.and - (_.coverage [/.export:] + (_.coverage [/.export] (and (n.= <nat> ..constant) (n.= (n.+ <nat> <nat>) (..shift <nat>)))) ))) diff --git a/stdlib/source/test/lux/ffi/export.rb.lux b/stdlib/source/test/lux/ffi/export.rb.lux index c785c9abd..f107536f2 100644 --- a/stdlib/source/test/lux/ffi/export.rb.lux +++ b/stdlib/source/test/lux/ffi/export.rb.lux @@ -11,7 +11,7 @@ ["/[1]" //]]]) (with_expansions [<nat> (static.random_nat)] - (/.export: + (/.export (def: nullary Nat <nat>) @@ -34,7 +34,7 @@ Test (<| (_.covering /._) (all _.and - (_.coverage [/.export:] + (_.coverage [/.export] (and (n.= <nat> (..nullary [])) (n.= (n.+ <nat> <nat>) (..unary <nat>)) (n.= <nat> (..CONSTANT)) diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index 531b43139..349ec7bbd 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -26,7 +26,7 @@ ["[0]" symbol]]]] [\\library ["[0]" / (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code (.open: "[1]#[0]" equivalence)] ["[0]" template]]] ["[0]" / @@ -45,20 +45,24 @@ [(is [Text .Global] [(template.text [<definition>]) {.#Definition [true .Macro <definition>]}])]) -(syntax: (pow/2 [number <code>.any]) - (in (list (` (n.* (~ number) (~ number)))))) +(def: pow/2 + (syntax (_ [number <code>.any]) + (in (list (` (n.* (~ number) (~ number))))))) -(syntax: (pow/4 [number <code>.any]) - (in (list (` (..pow/2 (..pow/2 (~ number))))))) +(def: pow/4 + (syntax (_ [number <code>.any]) + (in (list (` (..pow/2 (..pow/2 (~ number)))))))) -(syntax: (repeated [times <code>.nat - token <code>.any]) - (in (list.repeated times token))) +(def: repeated + (syntax (_ [times <code>.nat + token <code>.any]) + (in (list.repeated times token)))) -(syntax: (fresh_symbol []) - (do meta.monad - [g!fresh (/.symbol "fresh")] - (in (list g!fresh)))) +(def: fresh_symbol + (syntax (_ []) + (do meta.monad + [g!fresh (/.symbol "fresh")] + (in (list g!fresh))))) (def: random_lux (Random [Nat Text .Lux]) @@ -105,11 +109,12 @@ .#eval (as (-> Type Code (Meta Any)) []) .#host []]]))) -(syntax: (iterated [cycle <code>.nat - it <code>.any]) - (in (list (case cycle - 0 it - _ (` (..iterated (~ (code.nat (-- cycle))) (~ it))))))) +(def: iterated + (syntax (_ [cycle <code>.nat + it <code>.any]) + (in (list (case cycle + 0 it + _ (` (..iterated (~ (code.nat (-- cycle))) (~ it)))))))) (def: test|expansion Test diff --git a/stdlib/source/test/lux/macro/local.lux b/stdlib/source/test/lux/macro/local.lux index a38dc8be7..de1073f55 100644 --- a/stdlib/source/test/lux/macro/local.lux +++ b/stdlib/source/test/lux/macro/local.lux @@ -18,7 +18,7 @@ [dictionary ["[0]" plist]]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math ["[0]" random (.only Random)] @@ -27,14 +27,15 @@ [\\library ["[0]" /]]) -(syntax: (macro_error [macro <code>.any]) - (function (_ compiler) - (case ((macro.expansion macro) compiler) - {try.#Failure error} - {try.#Success [compiler (list (code.text error))]} - - {try.#Success _} - {try.#Failure "OOPS!"}))) +(def: macro_error + (syntax (_ [macro <code>.any]) + (function (_ compiler) + (case ((macro.expansion macro) compiler) + {try.#Failure error} + {try.#Success [compiler (list (code.text error))]} + + {try.#Success _} + {try.#Failure "OOPS!"})))) (def: (constant output) (-> Code Macro) @@ -42,27 +43,28 @@ (function (_ inputs lux) {try.#Success [lux (list output)]}))) -(syntax: (with [name (<code>.tuple (<>.and <code>.text <code>.text)) - constant <code>.any - pre_remove <code>.bit - body <code>.any]) - (macro.with_symbols [g!output] - (do meta.monad - [pop! (/.push (list [name (..constant constant)])) - [module short] (meta.normal name) - _ (if pre_remove - (let [remove_macro! (is (-> .Module .Module) - (revised .#definitions (plist.lacks short)))] - (function (_ lux) - {try.#Success [(revised .#modules (plist.revised module remove_macro!) lux) - []]})) - (in []))] - (let [pre_expansion (` (let [(~ g!output) (~ body)] - (exec (~ pop!) - (~ g!output))))] - (if pre_remove - (macro.full_expansion pre_expansion) - (in (list pre_expansion))))))) +(def: with + (syntax (_ [name (<code>.tuple (<>.and <code>.text <code>.text)) + constant <code>.any + pre_remove <code>.bit + body <code>.any]) + (macro.with_symbols [g!output] + (do meta.monad + [pop! (/.push (list [name (..constant constant)])) + [module short] (meta.normal name) + _ (if pre_remove + (let [remove_macro! (is (-> .Module .Module) + (revised .#definitions (plist.lacks short)))] + (function (_ lux) + {try.#Success [(revised .#modules (plist.revised module remove_macro!) lux) + []]})) + (in []))] + (let [pre_expansion (` (let [(~ g!output) (~ body)] + (exec (~ pop!) + (~ g!output))))] + (if pre_remove + (macro.full_expansion pre_expansion) + (in (list pre_expansion)))))))) (def: .public test Test diff --git a/stdlib/source/test/lux/macro/syntax.lux b/stdlib/source/test/lux/macro/syntax.lux index c5ddd0510..8c851a778 100644 --- a/stdlib/source/test/lux/macro/syntax.lux +++ b/stdlib/source/test/lux/macro/syntax.lux @@ -22,10 +22,11 @@ ["[1][0]" type ["[1]/[0]" variable]]]) -(/.syntax: (+/3 [a <code>.any - b <code>.any - c <code>.any]) - (in (list (` (all n.+ (~ a) (~ b) (~ c)))))) +(def: +/3 + (/.syntax (_ [a <code>.any + b <code>.any + c <code>.any]) + (in (list (` (all n.+ (~ a) (~ b) (~ c))))))) (def: .public test Test @@ -35,7 +36,7 @@ [x random.nat y random.nat z random.nat] - (_.coverage [/.syntax:] + (_.coverage [/.syntax] (n.= (all n.+ x y z) (+/3 x y z)))) diff --git a/stdlib/source/test/lux/macro/template.lux b/stdlib/source/test/lux/macro/template.lux index 771c9c082..715a0dbe2 100644 --- a/stdlib/source/test/lux/macro/template.lux +++ b/stdlib/source/test/lux/macro/template.lux @@ -13,7 +13,7 @@ [collection ["[0]" list]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math ["[0]" random (.only Random)] @@ -28,14 +28,15 @@ (-> Nat Nat) (|>> !pow/2))) -(syntax: (macro_error [macro <code>.any]) - (function (_ compiler) - (case ((macro.expansion macro) compiler) - {try.#Failure error} - {try.#Success [compiler (list (code.text error))]} - - {try.#Success _} - {try.#Failure "OOPS!"}))) +(def: macro_error + (syntax (_ [macro <code>.any]) + (function (_ compiler) + (case ((macro.expansion macro) compiler) + {try.#Failure error} + {try.#Success [compiler (list (code.text error))]} + + {try.#Success _} + {try.#Failure "OOPS!"})))) (def: .public test Test diff --git a/stdlib/source/test/lux/math/modulus.lux b/stdlib/source/test/lux/math/modulus.lux index 484a7470a..a3f26cdf5 100644 --- a/stdlib/source/test/lux/math/modulus.lux +++ b/stdlib/source/test/lux/math/modulus.lux @@ -13,17 +13,18 @@ [number ["i" int]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]]]] [\\library ["[0]" /]]) -(syntax: (|divisor| []) - (do meta.monad - [divisor meta.seed] - (in (list (code.int (case divisor - 0 +1 - _ (.int divisor))))))) +(def: |divisor| + (syntax (_ []) + (do meta.monad + [divisor meta.seed] + (in (list (code.int (case divisor + 0 +1 + _ (.int divisor)))))))) (def: .public (random range) (Ex (_ %) (-> Int (Random (/.Modulus %)))) diff --git a/stdlib/source/test/lux/meta/configuration.lux b/stdlib/source/test/lux/meta/configuration.lux index 734fbef82..45dcc5e5d 100644 --- a/stdlib/source/test/lux/meta/configuration.lux +++ b/stdlib/source/test/lux/meta/configuration.lux @@ -19,7 +19,7 @@ [collection ["[0]" list]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math ["[0]" random (.only Random) (.open: "[1]#[0]" monad)]]]] @@ -36,14 +36,15 @@ (at ! each (|>> (partial_list [feature value])) (random (-- amount)))))) -(syntax: (failure [it <code>.any]) - (function (_ lux) - (case (macro.expansion it lux) - {try.#Failure error} - {try.#Success [lux (list (code.text error))]} - - {try.#Success _} - {try.#Failure ""}))) +(def: failure + (syntax (_ [it <code>.any]) + (function (_ lux) + (case (macro.expansion it lux) + {try.#Failure error} + {try.#Success [lux (list (code.text error))]} + + {try.#Success _} + {try.#Failure ""})))) (def: .public test Test diff --git a/stdlib/source/test/lux/meta/version.lux b/stdlib/source/test/lux/meta/version.lux index e85fc8aa5..3a59251de 100644 --- a/stdlib/source/test/lux/meta/version.lux +++ b/stdlib/source/test/lux/meta/version.lux @@ -14,7 +14,7 @@ [data ["[0]" text]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math ["[0]" random] @@ -23,14 +23,15 @@ [\\library ["[0]" /]]) -(syntax: (failure [it <code>.any]) - (function (_ lux) - (case (macro.expansion it lux) - {try.#Failure error} - {try.#Success [lux (list (code.text error))]} - - {try.#Success _} - {try.#Failure ""}))) +(def: failure + (syntax (_ [it <code>.any]) + (function (_ lux) + (case (macro.expansion it lux) + {try.#Failure error} + {try.#Success [lux (list (code.text error))]} + + {try.#Success _} + {try.#Failure ""})))) (def: .public test Test diff --git a/stdlib/source/test/lux/program.lux b/stdlib/source/test/lux/program.lux index a6380c838..7e3430387 100644 --- a/stdlib/source/test/lux/program.lux +++ b/stdlib/source/test/lux/program.lux @@ -15,16 +15,17 @@ [collection ["[0]" list]]] [macro - [syntax (.only syntax:)]] + [syntax (.only syntax)]] [math ["[0]" random]]]] [\\library ["[0]" /]]) -(syntax: (actual_program [actual_program (<| <code>.form - (<>.after (<code>.this_text "lux def program")) - <code>.any)]) - (in (list actual_program))) +(def: actual_program + (syntax (_ [actual_program (<| <code>.form + (<>.after (<code>.this_text "lux def program")) + <code>.any)]) + (in (list actual_program)))) (def: .public test Test diff --git a/stdlib/source/test/lux/type/primitive.lux b/stdlib/source/test/lux/type/primitive.lux index 15b084af1..8ef01f41f 100644 --- a/stdlib/source/test/lux/type/primitive.lux +++ b/stdlib/source/test/lux/type/primitive.lux @@ -13,7 +13,7 @@ [data ["[0]" text (.open: "[1]#[0]" equivalence)]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code] ["[0]" template]] ["[0]" math (.only) @@ -25,24 +25,26 @@ (template.with_locals [g!Foo g!Bar] (these (template [<syntax> <meta>] - [(syntax: (<syntax> []) - (do meta.monad - [frame <meta>] - (in (list (code.text (the /.#name frame))))))] + [(def: <syntax> + (syntax (_ []) + (do meta.monad + [frame <meta>] + (in (list (code.text (the /.#name frame)))))))] [current /.current] [specific (/.specific (template.text [g!Foo]))] ) - (syntax: (with_no_active_frames [macro <code>.any]) - (function (_ compiler) - (let [verdict (case ((macro.expansion macro) compiler) - {try.#Failure error} - (exception.match? /.no_active_frames error) - - {try.#Success _} - false)] - {try.#Success [compiler (list (code.bit verdict))]}))) + (def: with_no_active_frames + (syntax (_ [macro <code>.any]) + (function (_ compiler) + (let [verdict (case ((macro.expansion macro) compiler) + {try.#Failure error} + (exception.match? /.no_active_frames error) + + {try.#Success _} + false)] + {try.#Success [compiler (list (code.bit verdict))]})))) (with_expansions [no_current! (..with_no_active_frames (..current)) no_specific! (..with_no_active_frames (..specific))] diff --git a/stdlib/source/test/lux/type/resource.lux b/stdlib/source/test/lux/type/resource.lux index 8a42a444e..3de50b8a7 100644 --- a/stdlib/source/test/lux/type/resource.lux +++ b/stdlib/source/test/lux/type/resource.lux @@ -19,7 +19,7 @@ ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]]] ["[0]" macro (.only) - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math ["[0]" random]]]] @@ -155,18 +155,19 @@ )) ))))) -(syntax: (with_error [exception <code>.symbol - to_expand <code>.any]) - (monad.do meta.monad - [[_ _ exception] (meta.export exception)] - (function (_ compiler) - {.#Right [compiler - (list (code.bit (case ((macro.single_expansion to_expand) compiler) - {try.#Success _} - false - - {try.#Failure error} - true)))]}))) +(def: with_error + (syntax (_ [exception <code>.symbol + to_expand <code>.any]) + (monad.do meta.monad + [[_ _ exception] (meta.export exception)] + (function (_ compiler) + {.#Right [compiler + (list (code.bit (case ((macro.single_expansion to_expand) compiler) + {try.#Success _} + false + + {try.#Failure error} + true)))]})))) (def: .public test Test diff --git a/stdlib/source/test/lux/type/unit.lux b/stdlib/source/test/lux/type/unit.lux index f976aae54..edf3fe6bd 100644 --- a/stdlib/source/test/lux/type/unit.lux +++ b/stdlib/source/test/lux/type/unit.lux @@ -12,7 +12,7 @@ ["$[0]" order] ["$[0]" enum]]] [macro - [syntax (.only syntax:)] + [syntax (.only syntax)] ["[0]" code]] [math ["[0]" random (.only Random)] @@ -77,10 +77,11 @@ (i.= expected))) ))))) -(syntax: (natural []) - (at meta.monad each - (|>> code.nat list) - meta.seed)) +(def: natural + (syntax (_ []) + (at meta.monad each + (|>> code.nat list) + meta.seed))) (with_expansions [<from> (..natural) <to> (..natural)] |