From 5b36c00da8a21c5d70adec4b50ef573e12dc5cf8 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 11 Jun 2022 00:10:52 -0400 Subject: De-sigil-ification: : [Part 2] --- .../source/library/lux/abstract/monad/indexed.lux | 61 +-- .../source/library/lux/control/concatenative.lux | 86 ++-- .../library/lux/control/concurrency/actor.lux | 109 ++-- stdlib/source/library/lux/control/continuation.lux | 9 +- stdlib/source/library/lux/control/exception.lux | 42 +- .../library/lux/control/function/contract.lux | 32 +- .../source/library/lux/control/function/inline.lux | 44 +- .../source/library/lux/control/function/mutual.lux | 188 +++---- stdlib/source/library/lux/control/io.lux | 11 +- stdlib/source/library/lux/control/lazy.lux | 9 +- stdlib/source/library/lux/control/pipe.lux | 162 +++--- stdlib/source/library/lux/control/remember.lux | 48 +- .../library/lux/control/security/capability.lux | 45 +- .../library/lux/data/collection/sequence.lux | 7 +- .../source/library/lux/data/collection/stream.lux | 25 +- stdlib/source/library/lux/data/collection/tree.lux | 11 +- .../source/library/lux/data/format/css/class.lux | 15 +- stdlib/source/library/lux/data/format/css/font.lux | 2 - stdlib/source/library/lux/data/format/css/id.lux | 15 +- .../library/lux/data/format/css/property.lux | 7 +- .../source/library/lux/data/format/css/query.lux | 7 +- .../source/library/lux/data/format/css/value.lux | 7 +- stdlib/source/library/lux/data/format/json.lux | 7 +- stdlib/source/library/lux/data/text/escape.lux | 17 +- stdlib/source/library/lux/data/text/format.lux | 7 +- stdlib/source/library/lux/data/text/regex.lux | 46 +- stdlib/source/library/lux/debug.lux | 107 ++-- stdlib/source/library/lux/documentation.lux | 213 ++++---- stdlib/source/library/lux/extension.lux | 41 +- stdlib/source/library/lux/ffi.jvm.lux | 547 +++++++++++---------- stdlib/source/library/lux/ffi.lux | 187 +++---- stdlib/source/library/lux/ffi.old.lux | 422 ++++++++-------- stdlib/source/library/lux/ffi.php.lux | 179 +++---- stdlib/source/library/lux/ffi.scm.lux | 58 ++- stdlib/source/library/lux/ffi/export.js.lux | 21 +- stdlib/source/library/lux/ffi/export.jvm.lux | 85 ++-- stdlib/source/library/lux/ffi/export.lua.lux | 21 +- stdlib/source/library/lux/ffi/export.py.lux | 21 +- stdlib/source/library/lux/ffi/export.rb.lux | 33 +- stdlib/source/library/lux/macro/syntax.lux | 48 +- stdlib/source/library/lux/macro/template.lux | 110 +++-- stdlib/source/library/lux/math.lux | 21 +- stdlib/source/library/lux/math/infix.lux | 7 +- stdlib/source/library/lux/math/modular.lux | 1 - stdlib/source/library/lux/math/modulus.lux | 13 +- stdlib/source/library/lux/math/number/complex.lux | 11 +- stdlib/source/library/lux/math/number/ratio.lux | 11 +- stdlib/source/library/lux/meta/configuration.lux | 33 +- stdlib/source/library/lux/meta/version.lux | 42 +- stdlib/source/library/lux/program.lux | 61 +-- stdlib/source/library/lux/static.lux | 150 +++--- stdlib/source/library/lux/target/jvm/modifier.lux | 21 +- stdlib/source/library/lux/target/lua.lux | 22 +- stdlib/source/library/lux/target/php.lux | 22 +- stdlib/source/library/lux/target/python.lux | 22 +- stdlib/source/library/lux/target/r.lux | 22 +- stdlib/source/library/lux/target/ruby.lux | 22 +- stdlib/source/library/lux/test.lux | 82 +-- .../lux/tool/compiler/language/lux/analysis.lux | 11 +- .../lux/phase/generation/common_lisp/runtime.lux | 102 ++-- .../language/lux/phase/generation/extension.lux | 52 +- .../language/lux/phase/generation/js/runtime.lux | 96 ++-- .../language/lux/phase/generation/lua/runtime.lux | 106 ++-- .../language/lux/phase/generation/php/runtime.lux | 108 ++-- .../lux/phase/generation/python/runtime.lux | 98 ++-- .../lux/phase/generation/r/procedure/common.lux | 52 +- .../language/lux/phase/generation/r/runtime.lux | 98 ++-- .../language/lux/phase/generation/ruby/runtime.lux | 116 ++--- .../phase/generation/scheme/extension/common.lux | 50 +- .../lux/phase/generation/scheme/runtime.lux | 96 ++-- stdlib/source/library/lux/type.lux | 154 +++--- stdlib/source/library/lux/type/dynamic.lux | 30 +- stdlib/source/library/lux/type/implicit.lux | 107 ++-- stdlib/source/library/lux/type/poly.lux | 34 +- stdlib/source/library/lux/type/primitive.lux | 86 ++-- stdlib/source/library/lux/type/quotient.lux | 41 +- stdlib/source/library/lux/type/refinement.lux | 39 +- stdlib/source/library/lux/type/resource.lux | 90 ++-- stdlib/source/library/lux/type/unit.lux | 103 ++-- .../source/library/lux/world/net/http/client.lux | 7 +- 80 files changed, 2774 insertions(+), 2577 deletions(-) (limited to 'stdlib/source/library') 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}]) .any))) -(syntax: .public (do [[?name monad] ..named_monad - context (.tuple (<>.some context)) - expression .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 (.tuple (<>.some context)) + expression .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 .any)]) - (in (list (` (|> (~! ..beginning) (~+ commands) ((~! ..end))))))) +(def: .public ||> + (syntax (_ [commands (<>.some .any)]) + (in (list (` (|> (~! ..beginning) (~+ commands) ((~! ..end)))))))) (def: word (Parser [Code Text Code (List Code)]) @@ -124,21 +126,23 @@ .any (<>.many .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) .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) .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 [] [(`` (def: .public (~~ (template.symbol ["apply_" ])) 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 @@ .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] (.tuple (<>.and .any .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] (.tuple (<>.and .any .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 @@ .any .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 .any]) - (with_symbols [g!_ g!k] - (in (list (` (.function ((~ g!_) (~ g!k)) ((~ g!k) (~ expr)))))))) +(def: .public pending + (syntax (_ [expr .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 .any .any))]) - (in (list (` ((~! ..report') (list (~+ (|> entries - (list#each (function (_ [header message]) - (` [(~ header) (~ message)]))))))))))) +(def: .public report + (syntax (_ [entries (<>.many (<>.and .any .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 .any - expr .any]) - (in (list (` (exec - ((~! ..assert!) (~ (code.text (exception.error ..pre_condition_failed test))) - (~ test)) - (~ expr)))))) +(def: .public pre + (syntax (_ [test .any + expr .any]) + (in (list (` (exec + ((~! ..assert!) (~ (code.text (exception.error ..pre_condition_failed test))) + (~ test)) + (~ expr))))))) -(syntax: .public (post [test .any - expr .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 .any + expr .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 @@ .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 (` (~! .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 (` (~! .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 (.tuple (<>.some ..mutual)) - body .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 (.tuple (<>.some ..mutual)) + body .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 @@ (.tuple (<>.either (<>.and .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 .any]) - (with_symbols [g!func g!arg] - (in (list (` ((~! ..label) (function ((~ g!func) (~ g!arg)) - (~ computation)))))))) + (def: .public io + (syntax (_ [computation .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 .any]) - (with_symbols [g!_] - (in (list (` ((~! ..lazy') (function ((~ g!_) (~ g!_)) (~ expression)))))))) +(def: .public lazy + (syntax (_ [expression .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)) (.tuple (<>.some .any))) -(syntax: .public (new [start .any - body ..body - prev .any]) - (in (list (` (|> (~ start) (~+ body)))))) +(def: .public new + (syntax (_ [start .any + body ..body + prev .any]) + (in (list (` (|> (~ start) (~+ body))))))) -(syntax: .public (let [binding .any - body .any - prev .any]) - (in (list (` (.let [(~ binding) (~ prev)] - (~ body)))))) +(def: .public let + (syntax (_ [binding .any + body .any + prev .any]) + (in (list (` (.let [(~ binding) (~ prev)] + (~ body))))))) (def: _reversed_ (Parser Any) (function (_ tokens) {try.#Success [(list.reversed tokens) []]})) -(syntax: .public (cond [_ _reversed_ - prev .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 .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 .any]) - (in (list (` (..cond [(~+ test)] [(~+ then)] - [(~+ else)] - (~ prev)))))) +(def: .public if + (syntax (_ [test ..body + then ..body + else ..body + prev .any]) + (in (list (` (..cond [(~+ test)] [(~+ then)] + [(~+ else)] + (~ prev))))))) -(syntax: .public (when [test ..body - then ..body - prev .any]) - (in (list (` (..cond [(~+ test)] [(~+ then)] - [] - (~ prev)))))) +(def: .public when + (syntax (_ [test ..body + then ..body + prev .any]) + (in (list (` (..cond [(~+ test)] [(~+ then)] + [] + (~ prev))))))) -(syntax: .public (while [test ..body - then ..body - prev .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 .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 .any - steps (<>.some ..body) - prev .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 .any + steps (<>.some ..body) + prev .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 .any]) - (with_symbols [g!temp] - (in (list (` (.let [(~ g!temp) (~ prev)] - (.exec (|> (~ g!temp) (~+ body)) - (~ g!temp)))))))) +(def: .public exec + (syntax (_ [body ..body + prev .any]) + (with_symbols [g!temp] + (in (list (` (.let [(~ g!temp) (~ prev)] + (.exec (|> (~ g!temp) (~+ body)) + (~ g!temp))))))))) -(syntax: .public (tuple [paths (<>.many ..body) - prev .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 .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 .any .any)) - prev .any]) - (in (list (` (.case (~ prev) - (~+ (|> branches - (list#each (function (_ [pattern body]) (list pattern body))) - list#conjoint))))))) +(def: .public case + (syntax (_ [branches (<>.many (<>.and .any .any)) + prev .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 .text - focus (<>.maybe .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 .text + focus (<>.maybe .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 [ ] - [(`` (syntax: .public ( [deadline ..deadline - message .text - focus (<>.maybe .any)]) - (in (list (` (..remember (~ (code.text (%.date deadline))) - (~ (code.text (format " " message))) - (~+ (case focus - {.#Some focus} - (list focus) + [(`` (def: .public + (syntax (_ [deadline ..deadline + message .text + focus (<>.maybe .any)]) + (in (list (` (..remember (~ (code.text (%.date deadline))) + (~ (code.text (format " " 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 - (.form (all <>.and .local .any .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 + (.form (all <>.and .local .any .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 .any)]) - (in (.list (` (..of_list (.list (~+ elems))))))) +(def: .public sequence + (syntax (_ [elems (<>.some .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 (.form (<>.many .any)) - body .any - branches (<>.some .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 (.form (<>.many .any)) + body .any + branches (<>.some .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 .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 .text]) - (in (list (code.local (text.replaced "-" "_" symbol))))) +(def: text_symbol + (syntax (_ [symbol .text]) + (in (list (code.local (text.replaced "-" "_" symbol)))))) (template: (enumeration: + +) [(primitive: .public 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 .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 .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 .any)]) - (in (.list (` (all "lux text concat" (~+ fragments)))))) +(def: .public format + (syntax (_ [fragments (<>.many .any)]) + (in (.list (` (all "lux text concat" (~+ fragments))))))) (template [ ] [(def: .public 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 .text]) - (do meta.monad - [current_module meta.current_module_name] - (case (.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] (.form (<>.and .text (<>.maybe .any))) - body .any - branches (<>.many .any)]) - (with_symbols [g!temp] - (in (partial_list (` (^.multi (~ g!temp) - [((~! .result) (..regex (~ (code.text pattern))) (~ g!temp)) - {try.#Success (~ (maybe.else g!temp bindings))}])) - body - branches)))) +(def: .public regex + (syntax (_ [pattern .text]) + (do meta.monad + [current_module meta.current_module_name] + (case (.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] (.form (<>.and .text (<>.maybe .any))) + body .any + branches (<>.many .any)]) + (with_symbols [g!temp] + (in (partial_list (` (^.multi (~ g!temp) + [((~! .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 .symbol]) - (let [[module _] definition] - (in (list (` ("lux in-module" - (~ (code.text module)) - (~ (code.symbol definition)))))))) +(def: .public private + (syntax (_ [definition .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 (.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 (.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 @@ (.form (<>.and ..qualified_symbol (<>.some (.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 .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 .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 .any - definitions (.tuple (<>.some .any)) - subs (.tuple (<>.some .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 .any + definitions (.tuple (<>.some .any)) + subs (.tuple (<>.some .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 @@ (.tuple (<>.some .any))))) (template [ ] - [(syntax: .public ( [[name extension phase archive inputs] (..declaration (` )) - body .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 (` ( (~ name) - (.function ((~ g!handler) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs)) - (.case ((~! ) - ((~! monad.do) (~! <>.monad) - [(~+ inputs) - (~ g!_) ] - (.at (~! <>.monad) (~' in) (~ body))) - (~ g!inputs)) - {.#Right (~ g!_)} - (~ g!_) + [(def: .public + (syntax (_ [[name extension phase archive inputs] (..declaration (` )) + body .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 (` ( (~ name) + (.function ((~ g!handler) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs)) + (.case ((~! ) + ((~! monad.do) (~! <>.monad) + [(~+ inputs) + (~ g!_) ] + (.at (~! <>.monad) (~' in) (~ body))) + (~ g!inputs)) + {.#Right (~ g!_)} + (~ g!_) - {.#Left (~ g!error)} - ((~! phase.failure) (~ g!error))) - ))))))))] + {.#Left (~ g!error)} + ((~! phase.failure) (~ g!error))) + )))))))))] [.any .end .and .result "lux def analysis" analysis:] [.any .end .and .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) - (.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) + (.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) + (.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) + (.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) - (.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) - (.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 .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 .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 .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 .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 .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 .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 .any - body .any]) - (in (list (` ("jvm object synchronized" (~ lock) (~ body)))))) - -(syntax: .public (do_to [obj .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 .any + body .any]) + (in (list (` ("jvm object synchronized" (~ lock) (~ body))))))) + +(def: .public do_to + (syntax (_ [obj .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 .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 .any]) - (let [g!size (` (|> (~ size) - (.is .Nat) - (.as (.Primitive (~ (code.text box.long)))) - "jvm object cast" - "jvm conversion long-to-int"))] - (`` (cond (~~ (template [ ] - [(at jvm.equivalence = type) - (in (list (` ( (~ 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 .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 .any]) + (let [g!size (` (|> (~ size) + (.is .Nat) + (.as (.Primitive (~ (code.text box.long)))) + "jvm object cast" + "jvm conversion long-to-int"))] + (`` (cond (~~ (template [ ] + [(at jvm.equivalence = type) + (in (list (` ( (~ 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 @@ _ )))) -(syntax: .public (length [array .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 [ ] - [(at jvm.equivalence = - (jvm.array ) - array_jvm_type) - ] - - [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 .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 [ ] + [(at jvm.equivalence = + (jvm.array ) + array_jvm_type) + ] + + [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 .any - array .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 [ ] - [(at jvm.equivalence = - (jvm.array ) - array_jvm_type) - (in (list (` (.|> ( (~ g!idx) (~ array)) - "jvm object cast" - (.is (.Primitive (~ (code.text ))))))))] - - [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 .any + array .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 [ ] + [(at jvm.equivalence = + (jvm.array ) + array_jvm_type) + (in (list (` (.|> ( (~ g!idx) (~ array)) + "jvm object cast" + (.is (.Primitive (~ (code.text ))))))))] + + [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 .any - value .any - array .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 [ ] - [(at jvm.equivalence = - (jvm.array ) - array_jvm_type) - (let [g!value (` (.|> (~ value) - (.as (.Primitive (~ (code.text )))) - "jvm object cast"))] - (in (list (` ( (~ 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 .any + value .any + array .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 [ ] + [(at jvm.equivalence = + (jvm.array ) + array_jvm_type) + (let [g!value (` (.|> (~ value) + (.as (.Primitive (~ (code.text )))) + "jvm object cast"))] + (in (list (` ( (~ 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 .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 .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 [ ] [(template: .public ( 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 (` ( (~ (code.text (%.format (..host_path class_name) "." field))))) - @.ruby (` ( (~ (code.text (%.format (..host_path class_name) "::" field))))) - (` ( (~ (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 (` ( (~ (code.text (%.format (..host_path class_name) "." field))))) + @.ruby (` ( (~ (code.text (%.format (..host_path class_name) "::" field))))) + (` ( (~ (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 .text) - it ..importP]) - (let [host_module_import! (is (List Code) - (case host_module - {.#Some host_module} - (list (` ( (~ (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! - (` ( (~ (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 .text) + it ..importP]) + (let [host_module_import! (is (List Code) + (case host_module + {.#Some host_module} + (list (` ( (~ (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! + (` ( (~ (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] (.form - (all <>.and - .local - (.tuple (<>.some (<>.and .any .any))))) - type .any - term .any]) - (in (list (` (.<| (.as ..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] (.form + (all <>.and + .local + (.tuple (<>.some (<>.and .any .any))))) + type .any + term .any]) + (in (list (` (.<| (.as ..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 .any - [head tail] (.tuple (<>.and .local (<>.some .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 .any + [head tail] (.tuple (<>.and .local (<>.some .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? ) [(.case (..global Any ) @@ -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 [ (..extension_name) (..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) - (.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) - (.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 (.tuple (<>.some ..type_param^)) - super (<>.else object_super_class - (..super_class_decl^ class_vars)) - interfaces (<>.else (list) - (.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) + (.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) + (.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 (.tuple (<>.some ..type_param^)) + super (<>.else object_super_class + (..super_class_decl^ class_vars)) + interfaces (<>.else (list) + (.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 .any]) - (with_symbols [g!temp] - (in (list (` (let [(~ g!temp) (~ expr)] - (if ("jvm object null?" (~ g!temp)) - {.#None} - {.#Some (~ g!temp)}))))))) - -(syntax: .public (!!! [expr .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 .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 .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 .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 .any - body .any]) - (in (list (` ("jvm object synchronized" (~ lock) (~ body)))))) - -(syntax: .public (do_to [obj .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 .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 .any + body .any]) + (in (list (` ("jvm object synchronized" (~ lock) (~ body))))))) + +(def: .public do_to + (syntax (_ [obj .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 .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 .any]) - (case type - (^.template [ ] - [(pattern {#GenericClass (list)}) - (in (list (` ( (~ 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 .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 .any]) + (case type + (^.template [ ] + [(pattern {#GenericClass (list)}) + (in (list (` ( (~ 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 .any]) - (in (list (` ("jvm arraylength" (~ array)))))) +(def: .public length + (syntax (_ [array .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 .any - array .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 [ ] - [ - (in (list (` ( (~ 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 .any + array .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 [ ] + [ + (in (list (` ( (~ 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 .any - value .any - array .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 [ ] - [ - (in (list (` ( (~ 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 .any + value .any + array .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 [ ] + [ + (in (list (` ( (~ 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 .any]) - ... {.#doc (example (case (try (risky_computation input)) - ... {.#Right success} - ... (do_something success) +(def: .public try + (syntax (_ [expression .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 .any]) - ... {.#doc (example (case (try (risky_computation input)) - ... {.#Right success} - ... (do_something success) +(def: .public try + (syntax (_ [expression .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 .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]) - (` ( (~ (code.text name)) (~ term)))))))))) + (def: .public export + (syntax (_ [exports (<>.many .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]) + (` ( (~ (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 .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" [] ((~' ) []) - (~' 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 .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" [] ((~' ) []) + (~' 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 .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]) - (` ( (~ (code.text name)) (~ term)))))))))) + (def: .public export + (syntax (_ [exports (<>.many .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]) + (` ( (~ (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 .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]) - (` ( (~ (code.text name)) (~ term)))))))))) + (def: .public export + (syntax (_ [exports (<>.many .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]) + (` ( (~ (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 .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]) - (` ( (~+ (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 .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]) + (` ( (~+ (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 (.tuple (<>.some .any))]) - (in parts)) - -(syntax: .public (amount [parts (.tuple (<>.some .any))]) - (in (list (code.nat (list.size parts))))) - -(syntax: .public (with_locals [locals (.tuple (<>.some .local)) - body .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 (.tuple (<>.some .any))]) + (in parts))) + +(def: .public amount + (syntax (_ [parts (.tuple (<>.some .any))]) + (in (list (code.nat (list.size parts)))))) + +(def: .public with_locals + (syntax (_ [locals (.tuple (<>.some .local)) + body .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))) (.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 [ ] - [(syntax: .public ( [name (<>.or (<>.and (..part true) (..part false)) - (..part false))]) - (case name - {.#Left [simple complex]} - (in (list ( [(text.interposed "" simple) - (text.interposed "" complex)]))) - - {.#Right simple} - (in (list (|> simple (text.interposed "") )))))] + [(def: .public + (syntax (_ [name (<>.or (<>.and (..part true) (..part false)) + (..part false))]) + (case name + {.#Left [simple complex]} + (in (list ( [(text.interposed "" simple) + (text.interposed "" complex)]))) + + {.#Right simple} + (in (list (|> simple (text.interposed "") ))))))] [symbol code.local code.symbol] ) @@ -152,26 +157,27 @@ #parameters parameters #template template]))) -(syntax: .public (let [locals (.tuple (<>.some ..local)) - body .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 (.tuple (<>.some ..local)) + body .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 ( [operands (<>.some .any)]) - (in (list (` ( (~+ operands))))))))] + (def: .public + (syntax (_ [operands (<>.some .any)]) + (in (list (` ( (~+ 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 ( [left .any - right .any]) - (in (list (` ( (~ left) (~ right))))))))] + (def: .public + (syntax (_ [left .any + right .any]) + (in (list (` ( (~ left) (~ right)))))))))] [= [[.Nat "lux i64 ="] [.Int "lux i64 ="] @@ -216,9 +218,10 @@ ... else (phase.except ..no_arithmetic_for [:it:])))))) - (syntax: .public ( [left .any - right .any]) - (in (list (` ( (~ left) (~ right))))))))] + (def: .public + (syntax (_ [left .any + right .any]) + (in (list (` ( (~ 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 .int]) - (meta.lifted - (do try.monad - [_ (..modulus divisor)] - (in (list (` ((~! try.trusted) (..modulus (~ (code.int divisor)))))))))) +(def: .public literal + (syntax (_ [divisor .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 .any - ?imaginary (<>.maybe .any)]) - (in (list (` [..#real (~ real) - ..#imaginary (~ (maybe.else (' +0.0) ?imaginary))])))) +(def: .public complex + (syntax (_ [real .any + ?imaginary (<>.maybe .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 .any - ?denominator (<>.maybe .any)]) - (in (list (` ((~! ..normal) [..#numerator (~ numerator) - ..#denominator (~ (maybe.else (' 1) ?denominator))]))))) +(def: .public ratio + (syntax (_ [numerator .any + ?denominator (<>.maybe .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 .any)) - default (<>.maybe .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 .any)) + default (<>.maybe .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 .text .any)) - default (<>.maybe .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 .text .any)) + default (<>.maybe .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 .local (.tuple (<>.some .any)))) -(syntax: .public (program: [args ..arguments^ - body .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 ((~! .result) (.is (~! (.Parser (io.IO .Any))) - ((~! do) (~! <>.monad) - [(~+ args) - (~ g!_) (~! .end)] - ((~' in) (~ initialization+event_loop)))) - (~ g!args)) - {.#Right (~ g!output)} - (~ g!output) +(def: .public program: + (syntax (_ [args ..arguments^ + body .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 ((~! .result) (.is (~! (.Parser (io.IO .Any))) + ((~! do) (~! <>.monad) + [(~+ args) + (~ g!_) (~! .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 [ ] - [(syntax: .public ( [expression .any]) - (at meta.monad each - (|>> (as ) list) - (meta.eval expression)))] + [(def: .public + (syntax (_ [expression .any]) + (at meta.monad each + (|>> (as ) list) + (meta.eval expression))))] [bit .Bit code.bit] [nat .Nat code.nat] @@ -38,35 +39,39 @@ (with_expansions [ (Ex (_ a) [(-> a Code) a])] - (syntax: .public (literal [format .any - expression .any]) - (do meta.monad - [pair (meta.eval (.type ) - (` [(~ format) (~ expression)])) - .let [[format expression] (as pair)]] - (in (list (format expression)))))) + (def: .public literal + (syntax (_ [format .any + expression .any]) + (do meta.monad + [pair (meta.eval (.type ) + (` [(~ format) (~ expression)])) + .let [[format expression] (as pair)]] + (in (list (format expression))))))) (with_expansions [ (Ex (_ a) [(-> a Code) (List a)])] - (syntax: .public (literals [format .any - expression .any]) - (do meta.monad - [pair (meta.eval (.type ) - (` [(~ format) (~ expression)])) - .let [[format expression] (as pair)]] - (in (list#each format expression))))) + (def: .public literals + (syntax (_ [format .any + expression .any]) + (do meta.monad + [pair (meta.eval (.type ) + (` [(~ format) (~ expression)])) + .let [[format expression] (as 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 [ ] - [(syntax: .public ( []) - (do meta.monad - [seed meta.seed - .let [[_ result] (random.result (random.pcg_32 [..pcg_32_magic_inc seed]) - )]] - (in (list ( result)))))] + [(def: .public + (syntax (_ []) + (do meta.monad + [seed meta.seed + .let [[_ result] (random.result (random.pcg_32 [..pcg_32_magic_inc seed]) + )]] + (in (list ( result))))))] [random_bit random.bit code.bit] [random_nat random.nat code.nat] @@ -78,53 +83,58 @@ (with_expansions [ (Ex (_ a) [(-> a Code) (Random a)])] - (syntax: .public (random [format .any - random .any]) - (do meta.monad - [pair (meta.eval (type ) - (` [(~ format) (~ random)])) - .let [[format random] (as 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 .any + random .any]) + (do meta.monad + [pair (meta.eval (type ) + (` [(~ format) (~ random)])) + .let [[format random] (as pair)] + seed meta.seed + .let [[_ result] (random.result (random.pcg_32 [..pcg_32_magic_inc seed]) + random)]] + (in (list (format result))))))) (with_expansions [ (Ex (_ a) [(-> a Code) (Random (List a))])] - (syntax: .public (randoms [format .any - random .any]) - (do meta.monad - [pair (meta.eval (type ) - (` [(~ format) (~ random)])) - .let [[format random] (as 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 .any + random .any]) + (do meta.monad + [pair (meta.eval (type ) + (` [(~ format) (~ random)])) + .let [[format random] (as 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 .any - then .any - else .any]) - (do meta.monad - [test (meta.eval .Bit test)] - (in (list (.if (as .Bit test) - then - else))))) +(def: .public if + (syntax (_ [test .any + then .any + else .any]) + (do meta.monad + [test (meta.eval .Bit test)] + (in (list (.if (as .Bit test) + then + else)))))) -(syntax: .public (cond [test,then/* (<>.some (<>.and .any .any)) - else .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 .any .any)) + else .any]) + (in (list (list#mix (function (_ [test then] else) + (` (..if (~ test) + (~ then) + (~ else)))) + else + (list.reversed test,then/*)))))) -(syntax: .public (when [test .any - then .any]) - (do meta.monad - [test (meta.eval .Bit test)] - (in (.if (as .Bit test) - (list then) - (list))))) +(def: .public when + (syntax (_ [test .any + then .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 .any - options (<>.many .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 .any + options (<>.many .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 .nat]) - (in (case arity - 0 (.list) - _ (|> (-- arity) - (enum.range n.enum 0) - (list#each (|>> %.nat code.local)))))) - -(syntax: (arity_types [arity .nat]) - (in (list.repeated arity (` ..Expression)))) +(def: arity_inputs + (syntax (_ [arity .nat]) + (in (case arity + 0 (.list) + _ (|> (-- arity) + (enum.range n.enum 0) + (list#each (|>> %.nat code.local))))))) + +(def: arity_types + (syntax (_ [arity .nat]) + (in (list.repeated arity (` ..Expression))))) (template [ +] [(with_expansions [ (arity_inputs ) 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 .nat]) - (in (case arity - 0 (.list) - _ (|> (-- arity) - (enum.range n.enum 0) - (list#each (|>> %.nat code.local)))))) - - (syntax: (arity_types [arity .nat]) - (in (list.repeated arity (` ..Expression)))) + (def: arity_inputs + (syntax (_ [arity .nat]) + (in (case arity + 0 (.list) + _ (|> (-- arity) + (enum.range n.enum 0) + (list#each (|>> %.nat code.local))))))) + + (def: arity_types + (syntax (_ [arity .nat]) + (in (list.repeated arity (` ..Expression))))) (template [ +] [(with_expansions [ (template.symbol ["apply/" ]) 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 .nat]) - (in (case arity - 0 (.list) - _ (|> (-- arity) - (enum.range n.enum 0) - (list#each (|>> %.nat code.local)))))) - -(syntax: (arity_types [arity .nat]) - (in (list.repeated arity (` (Expression Any))))) +(def: arity_inputs + (syntax (_ [arity .nat]) + (in (case arity + 0 (.list) + _ (|> (-- arity) + (enum.range n.enum 0) + (list#each (|>> %.nat code.local))))))) + +(def: arity_types + (syntax (_ [arity .nat]) + (in (list.repeated arity (` (Expression Any)))))) (template [ +] [(with_expansions [ (arity_inputs ) 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 .nat]) - (in (case arity - 0 (.list) - _ (|> arity - list.indices - (list#each (|>> %.nat code.local)))))) - - (syntax: (arity_types [arity .nat]) - (in (list.repeated arity (` ..Expression)))) + (def: arity_inputs + (syntax (_ [arity .nat]) + (in (case arity + 0 (.list) + _ (|> arity + list.indices + (list#each (|>> %.nat code.local))))))) + + (def: arity_types + (syntax (_ [arity .nat]) + (in (list.repeated arity (` ..Expression))))) (template [ +] [(with_expansions [ (template.symbol ["apply/" ]) 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 .nat]) - (in (case arity - 0 (.list) - _ (|> (-- arity) - (enum.range n.enum 0) - (list#each (|>> %.nat code.local)))))) - -(syntax: (arity_types [arity .nat]) - (in (list.repeated arity (` ..Expression)))) +(def: arity_inputs + (syntax (_ [arity .nat]) + (in (case arity + 0 (.list) + _ (|> (-- arity) + (enum.range n.enum 0) + (list#each (|>> %.nat code.local))))))) + +(def: arity_types + (syntax (_ [arity .nat]) + (in (list.repeated arity (` ..Expression))))) (template [ +] [(with_expansions [ (template.symbol ["apply/" ]) 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 .symbol]) - (do meta.monad - [_ (meta.export name)] - (in (list (symbol_code name))))) +(def: reference + (syntax (_ [name .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 [ ] - [(syntax: .public ( [coverage (.tuple (<>.many .any)) - condition .any]) - (let [coverage (list#each (function (_ definition) - (` ((~! ..reference) (~ definition)))) - coverage)] - (in (list (` ((~! ) - (is (.List .Symbol) - (.list (~+ coverage))) - (~ condition)))))))] + [(def: .public + (syntax (_ [coverage (.tuple (<>.many .any)) + condition .any]) + (let [coverage (list#each (function (_ definition) + (` ((~! ..reference) (~ definition)))) + coverage)] + (in (list (` ((~! ) + (is (.List .Symbol) + (.list (~+ coverage))) + (~ condition))))))))] [coverage' ..|coverage'|] [coverage ..|coverage|] ) -(syntax: .public (for [coverage (.tuple (<>.many .any)) - test .any]) - (let [coverage (list#each (function (_ definition) - (` ((~! ..reference) (~ definition)))) - coverage)] - (in (list (` ((~! ..|for|) - (is (.List .Symbol) - (.list (~+ coverage))) - (~ test))))))) +(def: .public for + (syntax (_ [coverage (.tuple (<>.many .any)) + test .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 .symbol - test .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 .symbol + test .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 [ ] - [(syntax: .public ( [content .any]) - (in (list (` (.<| {..#Reference} - - (~ content))))))] + [(def: .public + (syntax (_ [content .any]) + (in (list (` (.<| {..#Reference} + + (~ 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 (.tuple (<>.some .local)) - body .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 .local - (.form (<>.and .local - (<>.some .local)))) - 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 (.tuple (<>.some .local)) + body .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 .local + (.form (<>.and .local + (<>.some .local)))) + 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 .nat - elemT .any]) - (in (list (` [(~+ (list.repeated size elemT))])))) +(def: Vector + (syntax (_ [size .nat + elemT .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 .nat - name .local - type .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 .nat + name .local + type .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 (.tuple (<>.some .local)) - body .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 .local - (.form (<>.and .local - (<>.some .local)))) - 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 (.tuple (<>.some .local)) + body .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 .local + (.form (<>.and .local + (<>.some .local)))) + 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 (.tuple (<>.some .local)) - body .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 (.tuple (<>.some .local)) + body .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 .local - (.form (<>.and .local - (<>.some .local)))) - 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 .local + (.form (<>.and .local + (<>.some .local)))) + 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 (.tuple (<>.some .local)) - body .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 (.tuple (<>.some .local)) + body .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 .local - (.form (<>.and .local - (<>.some .local)))) - 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 .local + (.form (<>.and .local + (<>.some .local)))) + 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 (.tuple (<>.some .local)) - body .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 .local - (.form (<>.and .local - (<>.some .local)))) - 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 (.tuple (<>.some .local)) + body .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 .local + (.form (<>.and .local + (<>.some .local)))) + 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 .nat - elemT .any]) - (in (list (` [(~+ (list.repeated size elemT))])))) +(def: Vector + (syntax (_ [size .nat + elemT .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 - [(~+ (|> 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 + [(~+ (|> 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 (.tuple (<>.some .local)) - body .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 .local - (.form (<>.and .local - (<>.some .local)))) - 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 (.tuple (<>.some .local)) + body .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 .local + (.form (<>.and .local + (<>.some .local)))) + 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 (.tuple (<>.some .local)) - body .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 (.tuple (<>.some .local)) + body .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 .local - (.form (<>.and .local - (<>.some .local)))) - conditional_implementations (<>.some (.tuple (<>.and .any .any))) - default_implementation .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 .local + (.form (<>.and .local + (<>.some .local)))) + conditional_implementations (<>.some (.tuple (<>.and .any .any))) + default_implementation .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 .nat - elemT .any]) - (in (list (` [(~+ (list.repeated size elemT))])))) +(def: Vector + (syntax (_ [size .nat + elemT .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 .local - arity .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 .local + arity .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 (.tuple (<>.some .local)) - body .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 .local - (.form (<>.and .local - (<>.some .local)))) - 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 (.tuple (<>.some .local)) + body .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 .local + (.form (<>.and .local + (<>.some .local)))) + 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 .symbol - (<>.maybe (<>.after (.this_symbol ..secret_marker) .any))) - .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 .symbol + (<>.maybe (<>.after (.this_symbol ..secret_marker) .any))) + .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)) (.tuple (<>.some .local))) -(syntax: .public (as [type_vars type_parameters - input .any - output .any - value (<>.maybe .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 .any + output .any + value (<>.maybe .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 .any .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 .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 .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 (.tuple (<>.some (<>.and .any .any))) - bodyT .any]) - (in (list (` (..with_expansions [(~+ (|> bindings - (list#each (.function (_ [localT valueT]) - (list localT (` (.these (~ valueT)))))) - list#conjoint))] - (~ bodyT)))))) +(def: .public let + (syntax (_ [bindings (.tuple (<>.some (<>.and .any .any))) + bodyT .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 .any]) - (with_symbols [g!value] - (in (list (` (.let [(~ g!value) (~ value)] - ((~! ..abstraction) [(.type_of (~ g!value)) (~ g!value)]))))))) + (def: .public dynamic + (syntax (_ [value .any]) + (with_symbols [g!value] + (in (list (` (.let [(~ g!value) (~ value)] + ((~! ..abstraction) [(.type_of (~ g!value)) (~ g!value)])))))))) - (syntax: .public (static [type .any - value .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 .any + value .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 .symbol - args (<>.or (<>.and (<>.some .symbol) .end) - (<>.and (<>.some .any) .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 .symbol + args (<>.or (<>.and (<>.some .symbol) .end) + (<>.and (<>.some .any) .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)) (.tuple (<>.many .any))) -(syntax: .public (with [implementations ..implicits - body .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 .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 .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) (~! .any)]) - ((~! do) (~! meta.monad) - [(~ g!type) ((~! meta.eval) .Type (~ g!type))] - (case (is (.Either .Text .Code) - ((~! .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) (~! .any)]) + ((~! do) (~! meta.monad) + [(~ g!type) ((~! meta.eval) .Type (~ g!type))] + (case (is (.Either .Text .Code) + ((~! .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}) .any))) (template [ ] - [(syntax: .public ( [[frame value] ..cast]) - (do meta.monad - [[name type_vars abstraction representation] (peek! frame)] - (in (list (` ((~! //.as) [(~+ type_vars)] (~ ) (~ ) - (~ value)))))))] + [(def: .public + (syntax (_ [[frame value] ..cast]) + (do meta.monad + [[name type_vars abstraction representation] (peek! frame)] + (in (list (` ((~! //.as) [(~+ type_vars)] (~ ) (~ ) + (~ 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 .any parser) parser)) -(syntax: .public (transmutation [selection (..selection .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 .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 .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 .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 .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 .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 [ ] - [(syntax: .public ( [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!!) - [ (~ g!context)] - [ (~ g!context)] - .Any))) - (function ((~ g!_) (~ g!!) [ (~ g!context)]) - (at (~ g!!) (~' in) [[ (~ g!context)] []])))))))))] + [(def: .public + (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!!) + [ (~ g!context)] + [ (~ g!context)] + .Any))) + (function ((~ g!_) (~ g!!) [ (~ g!context)]) + (at (~ g!!) (~' in) [[ (~ 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 - .local - .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 + .local + .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 - .local - .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 + .local + .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 .local]) - (in (list (code.local (text.lower_cased type_name))))) +(def: implementation_name + (syntax (_ [type_name .local]) + (in (list (code.local (text.lower_cased type_name)))))) (template [ ] [(`` (scale: .public 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] .symbol]) - (in (list (code.local (text.replaced "#" "" (text.lower_cased name)))))) +(def: method_function + (syntax (_ [[_ name] .symbol]) + (in (list (code.local (text.replaced "#" "" (text.lower_cased name))))))) (template [] [(with_expansions [ (method_function )] -- cgit v1.2.3