From 659537b4ec859f1e705cdd1f82da29ab1a662d94 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 9 Apr 2022 04:10:28 -0400 Subject: De-sigil-ification: * --- stdlib/source/library/lux/ffi/export.rb.lux | 4 +- stdlib/source/library/lux/macro/syntax.lux | 19 ++++--- stdlib/source/library/lux/target/js.lux | 6 +- stdlib/source/library/lux/target/php.lux | 10 ++-- stdlib/source/library/lux/target/python.lux | 6 +- stdlib/source/library/lux/target/ruby.lux | 14 ++--- stdlib/source/library/lux/target/scheme.lux | 8 +-- .../extension/generation/common_lisp/common.lux | 2 +- .../lux/phase/extension/generation/js/common.lux | 6 +- .../lux/phase/extension/generation/js/host.lux | 4 +- .../lux/phase/extension/generation/php/common.lux | 4 +- .../lux/phase/extension/generation/php/host.lux | 2 +- .../phase/extension/generation/python/common.lux | 2 +- .../lux/phase/extension/generation/python/host.lux | 10 ++-- .../lux/phase/extension/generation/r/common.lux | 2 +- .../lux/phase/extension/generation/ruby/common.lux | 2 +- .../lux/phase/extension/generation/ruby/host.lux | 2 +- .../phase/extension/generation/scheme/common.lux | 2 +- .../lux/phase/extension/generation/scheme/host.lux | 2 +- .../language/lux/phase/generation/js/case.lux | 8 +-- .../language/lux/phase/generation/js/function.lux | 4 +- .../language/lux/phase/generation/js/loop.lux | 2 +- .../language/lux/phase/generation/js/runtime.lux | 2 +- .../language/lux/phase/generation/php/case.lux | 2 +- .../language/lux/phase/generation/php/function.lux | 4 +- .../language/lux/phase/generation/php/loop.lux | 4 +- .../language/lux/phase/generation/php/runtime.lux | 2 +- .../language/lux/phase/generation/python/case.lux | 8 +-- .../lux/phase/generation/python/function.lux | 6 +- .../language/lux/phase/generation/python/loop.lux | 4 +- .../lux/phase/generation/python/runtime.lux | 6 +- .../language/lux/phase/generation/ruby/case.lux | 4 +- .../lux/phase/generation/ruby/function.lux | 14 ++--- .../language/lux/phase/generation/ruby/loop.lux | 2 +- .../language/lux/phase/generation/ruby/runtime.lux | 6 +- .../lux/phase/generation/scheme/function.lux | 4 +- .../language/lux/phase/generation/scheme/loop.lux | 66 +++++++++++----------- .../lux/phase/generation/scheme/runtime.lux | 4 +- 38 files changed, 132 insertions(+), 127 deletions(-) (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/ffi/export.rb.lux b/stdlib/source/library/lux/ffi/export.rb.lux index 017f40093..08f765b25 100644 --- a/stdlib/source/library/lux/ffi/export.rb.lux +++ b/stdlib/source/library/lux/ffi/export.rb.lux @@ -120,8 +120,8 @@ (/.return term)) _ - (/.statement (/.apply/* (list (/.string name) term) {.#None} - (/.manual "define_method")))))] + (/.statement (/.apply (list (/.string name) term) {.#None} + (/.manual "define_method")))))] _ (generation.execute! code) _ (generation.save! @self {.#None} code)] (generation.log! (%.format "Export " (%.text name)))))] diff --git a/stdlib/source/library/lux/macro/syntax.lux b/stdlib/source/library/lux/macro/syntax.lux index 9a2e566f0..2d092eaa6 100644 --- a/stdlib/source/library/lux/macro/syntax.lux +++ b/stdlib/source/library/lux/macro/syntax.lux @@ -1,7 +1,6 @@ (.using [library [lux "*" - ["[0]" macro {"+" with_symbols}] ["[0]" meta] [abstract ["[0]" monad {"+" do}]] @@ -20,7 +19,7 @@ ["[0]" int] ["[0]" rev] ["[0]" frac]]]]] - [// + ["[0]" // {"+" with_symbols} ["[0]" code]] ["[0]" / "_" ["[1][0]" export]]) @@ -44,17 +43,18 @@ {.#Item [[x y] pairs']} (partial_list x y (un_paired pairs')))) (def: syntax - (Parser [Code [Text (List Code)] Code]) + (Parser [Code [Text (Maybe Text) (List Code)] Code]) (/export.parser (all <>.and (.form (all <>.and .local + (<>.maybe .local) (.tuple (<>.some .any)))) .any))) (macro: .public (syntax: tokens) (case (.result ..syntax tokens) - {try.#Success [export_policy [name args] body]} + {try.#Success [export_policy [name g!state args] body]} (with_symbols [g!tokens g!body g!error] (do [! meta.monad] [vars+parsers (case (list.pairs args) @@ -78,9 +78,14 @@ _ (meta.failure "Syntax pattern expects pairs of bindings and code-parsers.")) + g!state (case g!state + {.#Some g!state} + (in (code.local g!state)) + + {.#None} + (//.symbol "g!state")) this_module meta.current_module_name - .let [g!state (code.symbol ["" "*lux*"]) - error_msg (code.text (macro.wrong_syntax_error [this_module name]))]] + .let [error_msg (code.text (//.wrong_syntax_error [this_module name]))]] (in (list (` (.macro: (~ export_policy) ((~ (code.symbol ["" name])) (~ g!tokens) (~ g!state)) (.case ((~! .result) (is ((~! .Parser) (Meta (List Code))) @@ -95,4 +100,4 @@ {try.#Failure ((~! text.interposed) (~! text.new_line) (list (~ error_msg) (~ g!error)))}))))))) {try.#Failure error} - (meta.failure (macro.wrong_syntax_error (symbol ..syntax:))))) + (meta.failure (//.wrong_syntax_error (symbol ..syntax:))))) diff --git a/stdlib/source/library/lux/target/js.lux b/stdlib/source/library/lux/target/js.lux index c0c178bc1..45d84ba99 100644 --- a/stdlib/source/library/lux/target/js.lux +++ b/stdlib/source/library/lux/target/js.lux @@ -139,7 +139,7 @@ (-> Text Expression Access) (abstraction (format (representation object) "." field))) - (def: .public (apply_* function inputs) + (def: .public (apply function inputs) (-> Expression (List Expression) Computation) (|> inputs (list#each ..code) @@ -150,7 +150,7 @@ (def: .public (do method inputs object) (-> Text (List Expression) Expression Computation) - (apply_* (..the method object) inputs)) + (apply (..the method object) inputs)) (def: .public object (-> (List [Text Expression]) Computation) @@ -428,7 +428,7 @@ [(`` (def: .public ( function) (-> Expression (~~ (template.spliced +)) Computation) (.function (_ (~~ (template.spliced +))) - (..apply_* function (list (~~ (template.spliced +))))))) + (..apply function (list (~~ (template.spliced +))))))) (`` (template [ ] [(def: .public ( (..var )))] diff --git a/stdlib/source/library/lux/target/php.lux b/stdlib/source/library/lux/target/php.lux index 5a8d6faf2..ea33a351b 100644 --- a/stdlib/source/library/lux/target/php.lux +++ b/stdlib/source/library/lux/target/php.lux @@ -190,15 +190,15 @@ (-> (List Expression) Text) (|>> (list#each ..code) (text.interposed ..input_separator) ..group)) - (def: .public (apply/* args func) + (def: .public (apply args func) (-> (List Expression) Expression Computation) (|> (format (representation func) (..arguments args)) abstraction)) ... TODO: Remove when no longer using JPHP. - (def: .public (apply/*' args func) + (def: .public (apply' args func) (-> (List Expression) Expression Computation) - (apply/* (partial_list func args) (..constant "call_user_func"))) + (apply (partial_list func args) (..constant "call_user_func"))) (def: parameters (-> (List Argument) Text) @@ -249,7 +249,7 @@ (template.spliced +)] (def: .public ( function []) (-> Expression [] Computation) - (..apply/* (.list ) function)) + (..apply (.list ) function)) (template [] [(`` (def: .public (~~ (template.symbol [ "/" ])) @@ -322,7 +322,7 @@ (def: .public (array_merge/+ required optionals) (-> Expression (List Expression) Computation) - (..apply/* (partial_list required optionals) (..constant "array_merge"))) + (..apply (partial_list required optionals) (..constant "array_merge"))) (def: .public (array/** kvs) (-> (List [Expression Expression]) Literal) diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index 8ab7a88ec..10045f1ea 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -228,7 +228,7 @@ (-> (List [(Expression Any) (Expression Any)]) (Computation Any)) (composite_literal "{" "}" (.function (_ [k v]) (format (representation k) " : " (representation v))))) - (def: .public (apply/* args func) + (def: .public (apply args func) (-> (List (Expression Any)) (Expression Any) (Computation Any)) (<| abstraction ... ..expression @@ -256,7 +256,7 @@ (-> Text (List (Expression Any)) (Expression Any) (Computation Any)) (|> object (..the method) - (..apply/* args))) + (..apply args))) (def: .public (item idx array) (-> (Expression Any) (Expression Any) Access) @@ -467,7 +467,7 @@ (template [] [(`` (def: .public ((~~ (template.symbol [ "/" ])) ) (-> (~~ (arity_types )) (Computation Any)) - (..apply/* (.list ) (..var ))))] + (..apply (.list ) (..var ))))] ))] diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index 972628596..3bcf32d02 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -241,7 +241,7 @@ (..nested (representation (.the #body it)))) (text.enclosed ["{" "}"]))) - (def: .public (apply/* arguments block func) + (def: .public (apply arguments block func) (-> (List Expression) (Maybe Block) Expression Computation) (let [arguments (|> arguments (list#each (|>> representation)) @@ -451,7 +451,7 @@ [(`` (def: .public ((~~ (template.symbol [ "/*"])) attributes) (-> (List Text) Statement) (..statement - (..apply/* (list#each ..string attributes) {.#None} (..manual )))))] + (..apply (list#each ..string attributes) {.#None} (..manual )))))] ["attr_reader"] ["attr_writer"] @@ -460,7 +460,7 @@ (def: .public (do method arguments block object) (-> Text (List Expression) (Maybe Block) Expression Computation) - (|> object (..the method) (..apply/* arguments block))) + (|> object (..the method) (..apply arguments block))) (def: .public new (-> (List Expression) (Maybe Block) Expression Computation) @@ -476,7 +476,7 @@ (|> (..manual "Module") (..new (list) {.#Some definition}))) -(def: .public (apply_lambda/* args lambda) +(def: .public (apply_lambda args lambda) (-> (List Expression) Expression Computation) (|> lambda (..do "call" args {.#None}))) @@ -499,7 +499,7 @@ (template [] [(`` (def: .public ((~~ (template.symbol [ "/" ])) ) (-> Computation) - (..apply/* (.list ) {.#None} (..manual ))))] + (..apply (.list ) {.#None} (..manual ))))] ))] @@ -520,11 +520,11 @@ (def: .public (throw/1 error) (-> Expression Statement) - (..statement (..apply/* (list error) {.#None} (..manual "throw")))) + (..statement (..apply (list error) {.#None} (..manual "throw")))) (def: .public (throw/2 tag value) (-> Expression Expression Statement) - (..statement (..apply/* (list tag value) {.#None} (..manual "throw")))) + (..statement (..apply (list tag value) {.#None} (..manual "throw")))) (def: .public (class_variable_set var value object) (-> SVar Expression Expression Computation) diff --git a/stdlib/source/library/lux/target/scheme.lux b/stdlib/source/library/lux/target/scheme.lux index d7b97bd0b..5a174b9db 100644 --- a/stdlib/source/library/lux/target/scheme.lux +++ b/stdlib/source/library/lux/target/scheme.lux @@ -174,14 +174,14 @@ (text.enclosed ["(" ")"]) abstraction))))) - (def: .public (apply/* args func) + (def: .public (apply args func) (-> (List Expression) Expression Computation) (..form {.#Item func args})) (template [ ] [(def: .public ( members) (-> (List Expression) Computation) - (..apply/* members (..var )))] + (..apply members (..var )))] [vector/* "vector"] [list/* "list"] @@ -189,7 +189,7 @@ (def: .public apply/0 (-> Expression Computation) - (..apply/* (list))) + (..apply (list))) (template [ ] [(def: .public @@ -202,7 +202,7 @@ [(`` (def: .public ( procedure) (-> Expression (~~ (template.spliced +)) Computation) (function (_ (~~ (template.spliced +))) - (..apply/* (list (~~ (template.spliced +))) procedure)))) + (..apply (list (~~ (template.spliced +))) procedure)))) (`` (template [ ] [(def: .public ( (..var )))] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux index 1c4b6e9d3..0a4a86df5 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux @@ -52,7 +52,7 @@ (/////.except extension.invalid_syntax [extension_name %synthesis input])))) (template: (!unary function) - (|>> list _.apply/* (|> (_.constant function)))) + (|>> list _.apply (|> (_.constant function)))) ... ... TODO: Get rid of this ASAP ... (def: lux::syntax_char_case! diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux index a85bc1fb6..c935634c7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux @@ -67,7 +67,7 @@ (def: f64//decode (Unary Expression) (|>> list - (_.apply_* (_.var "parseFloat")) + (_.apply (_.var "parseFloat")) _.return (_.closure (list)) //runtime.lux//try)) @@ -76,7 +76,7 @@ (Unary Expression) (|>> //runtime.i64##number (list) - (_.apply_* (_.var "String.fromCharCode")))) + (_.apply (_.var "String.fromCharCode")))) ... [[Text]] (def: (text//concat [leftG rightG]) @@ -167,7 +167,7 @@ (in [(list#each (|>> .int _.int) chars) branch!]))) conditionals))] - ... (in (_.apply_* (_.closure (list) + ... (in (_.apply (_.closure (list) ... (_.switch (_.the //runtime.i64_low_field inputG) ... conditionals! ... {.#Some (_.return else!)})) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux index 783dde8e3..055fec9ee 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux @@ -124,7 +124,7 @@ (do [! ////////phase.monad] [abstractionG (phase archive abstractionS) inputsG (monad.each ! (phase archive) inputsS)] - (in (_.apply_* abstractionG inputsG))))])) + (in (_.apply abstractionG inputsG))))])) (def: js::function (custom @@ -143,7 +143,7 @@ (_.define g!abstraction abstractionG) (_.return (case (.nat arity) 0 (_.apply_1 g!abstraction //runtime.unit) - 1 (_.apply_* g!abstraction g!inputs) + 1 (_.apply g!abstraction g!inputs) _ (_.apply_1 g!abstraction (_.array g!inputs)))))))))])) (def: .public bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux index e592ebd5c..82eb02ee5 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux @@ -52,7 +52,7 @@ (/////.except extension.invalid_syntax [extension_name %synthesis input])))) (template: (!unary function) - (|>> list _.apply/* (|> (_.constant function)))) + (|>> list _.apply (|> (_.constant function)))) ... TODO: Get rid of this ASAP (def: lux::syntax_char_case! @@ -95,7 +95,7 @@ conditionalsG))] _ (generation.execute! directive) _ (generation.save! context_artifact directive)] - (in (_.apply/* (partial_list inputG foreigns) @expression))))])) + (in (_.apply (partial_list inputG foreigns) @expression))))])) (def: lux_procs Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux index 2e257bcfc..b4be6893f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux @@ -118,7 +118,7 @@ (do [! ////////phase.monad] [abstractionG (phase archive abstractionS) inputsG (monad.each ! (phase archive) inputsS)] - (in (_.apply/* inputsG abstractionG))))])) + (in (_.apply inputsG abstractionG))))])) (def: php::pack (custom diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux index 9de656cd2..89092a241 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux @@ -146,7 +146,7 @@ ... _ (generation.execute! closure) ... _ (generation.save! (product.right artifact_id) {.#None} closure) ] - ... (in (_.apply/* @closure dependencies)) + ... (in (_.apply @closure dependencies)) (in (<| (as (Expression Any)) (is (Statement Any)) (all _.then diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux index 766979aa0..2b06a7946 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux @@ -115,7 +115,7 @@ (function (_ extension phase archive module) (do ////////phase.monad [] - (in (_.apply/* (list (_.string module)) (_.var "__import__")))))])) + (in (_.apply (list (_.string module)) (_.var "__import__")))))])) (def: python::apply (custom @@ -124,7 +124,7 @@ (do [! ////////phase.monad] [abstractionG (phase archive abstractionS) inputsG (monad.each ! (phase archive) inputsS)] - (in (_.apply/* inputsG abstractionG))))])) + (in (_.apply inputsG abstractionG))))])) (def: python::function (custom @@ -139,9 +139,9 @@ (list.repeated (.nat arity) []))] (in (_.lambda g!inputs (case (.nat arity) - 0 (_.apply/* (list //runtime.unit) abstractionG) - 1 (_.apply/* g!inputs abstractionG) - _ (_.apply/* (list (_.list g!inputs)) abstractionG))))))])) + 0 (_.apply (list //runtime.unit) abstractionG) + 1 (_.apply g!inputs abstractionG) + _ (_.apply (list (_.list g!inputs)) abstractionG))))))])) (def: python::exec (custom diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux index 5b6428fa8..eba2036c4 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux @@ -52,7 +52,7 @@ (/////.except extension.invalid_syntax [extension_name %synthesis input])))) ... (template: (!unary function) -... (|>> list _.apply/* (|> (_.constant function)))) +... (|>> list _.apply (|> (_.constant function)))) ... ... ... TODO: Get rid of this ASAP ... ... (def: lux::syntax_char_case! diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux index 2a838bef9..bec0ecdc2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux @@ -132,7 +132,7 @@ ... (_.return else!) ... conditionals!))] ] - ... (in (_.apply_lambda/* (list inputG) closure)) + ... (in (_.apply_lambda (list inputG) closure)) (in (<| (as Expression) (is Statement) (all _.then diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux index 2c6013cf1..a5f389ec9 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux @@ -113,7 +113,7 @@ (do [! ////////phase.monad] [abstractionG (phase archive abstractionS) inputsG (monad.each ! (phase archive) inputsS)] - (in (_.apply/* inputsG {.#None} abstractionG))))])) + (in (_.apply inputsG {.#None} abstractionG))))])) (def: ruby::import (custom diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux index 144415363..4a1218b26 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux @@ -52,7 +52,7 @@ (/////.except extension.invalid_syntax [extension_name %synthesis input])))) (template: (!unary function) - (|>> list _.apply/* (|> (_.constant function)))) + (|>> list _.apply (|> (_.constant function)))) ... TODO: Get rid of this ASAP (def: lux::syntax_char_case! diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux index 6b53f712f..aedc15c3f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux @@ -94,7 +94,7 @@ (do [! ////////phase.monad] [abstractionG (phase archive abstractionS) inputsG (monad.each ! (phase archive) inputsS)] - (in (_.apply/* inputsG abstractionG))))])) + (in (_.apply inputsG abstractionG))))])) (def: .public bundle Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/case.lux index 515518eb7..de443a7c7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/case.lux @@ -63,9 +63,9 @@ [valueO (expression archive valueS) bodyO (expression archive bodyS)] ... TODO: Find some way to do 'let' without paying the price of the closure. - (in (_.apply_* (_.closure (list (..register register)) - (_.return bodyO)) - (list valueO))))) + (in (_.apply (_.closure (list (..register register)) + (_.return bodyO)) + (list valueO))))) (def: .public (let! statement expression archive [valueS register bodyS]) (Generator! [Synthesis Register Synthesis]) @@ -342,4 +342,4 @@ (-> Phase! (Generator [Synthesis Path])) (do ///////phase.monad [pattern_matching! (..case! statement expression archive [valueS pathP])] - (in (_.apply_* (_.closure (list) pattern_matching!) (list))))) + (in (_.apply (_.closure (list) pattern_matching!) (list))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux index 4f3b402f6..15c0a984a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux @@ -38,7 +38,7 @@ (do [! ///////phase.monad] [functionO (expression archive functionS) argsO+ (monad.each ! (expression archive) argsS+)] - (in (_.apply_* functionO argsO+)))) + (in (_.apply functionO argsO+)))) (def: capture (-> Register Var) @@ -56,7 +56,7 @@ (|> (list.enumeration inits) (list#each (|>> product.left ..capture))) (_.return (_.function @self (list) body!))) - (_.apply_* @self inits)])) + (_.apply @self inits)])) (def: @curried (_.var "curried")) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/loop.lux index 8d92a81dd..62da60326 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/loop.lux @@ -93,7 +93,7 @@ _ (do [! ///////phase.monad] [loop! (scope! statement expression archive [start initsS+ bodyS])] - (in (_.apply_* (_.closure (list) loop!) (list)))))) + (in (_.apply (_.closure (list) loop!) (list)))))) (def: @temp (_.var "lux_again_values")) 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 57f34fed4..13f2a82e0 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 @@ -118,7 +118,7 @@ inputs_typesC (list#each (function.constant (` _.Expression)) inputs)] (in (list (` (def: .public ((~ g!name) (~+ inputsC)) (-> (~+ inputs_typesC) Computation) - (_.apply_* (~ runtime_name) (list (~+ inputsC))))) + (_.apply (~ runtime_name) (list (~+ inputsC))))) (` (def: (~ (code.local (format "@" name))) Statement diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux index 1d2c9aea8..c950b555c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux @@ -293,4 +293,4 @@ directive (_.define_function @case (list#each _.parameter @dependencies+) case!)] _ (/////generation.execute! directive) _ (/////generation.save! case_artifact directive)] - (in (_.apply/* @dependencies+ @case)))) + (in (_.apply @dependencies+ @case)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux index dfbc53fd3..e9cc9f517 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux @@ -34,7 +34,7 @@ (do [! ///////phase.monad] [functionG (expression archive functionS) argsG+ (monad.each ! (expression archive) argsS+)] - (in (_.apply/*' argsG+ functionG)))) + (in (_.apply' argsG+ functionG)))) (def: capture (-> Register Var) @@ -65,7 +65,7 @@ (list) body!)) (_.return @selfL)))) - (_.apply/* inits @selfG)]))) + (_.apply inits @selfG)]))) (def: .public (function statement expression archive [environment arity bodyS]) (-> Phase! (Generator (Abstraction Synthesis))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux index fb76fdea7..3c12092c7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux @@ -100,10 +100,10 @@ foreigns [(<| (_.define_function @loop (list#each _.parameter foreigns)) (_.return (_.closure (list#each _.parameter foreigns) (list) scope!))) - (_.apply/* foreigns @loop)]))] + (_.apply foreigns @loop)]))] _ (/////generation.execute! directive) _ (/////generation.save! loop_artifact directive)] - (in (_.apply/* (list) instantiation))))) + (in (_.apply (list) instantiation))))) ... TODO: Stop using a constant hard-coded variable. Generate a new one each time. (def: @temp 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 dfa7afe2f..d8885e026 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 @@ -116,7 +116,7 @@ inputs)] (in (list (` (def: .public ((~ g!name) (~+ inputsC)) (-> (~+ inputs_typesC) Computation) - (_.apply/* (list (~+ inputsC)) (~ runtime_name)))) + (_.apply (list (~+ inputsC)) (~ runtime_name)))) (` (def: (~ (code.local (format "@" name))) Statement diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux index 0479e132e..19d8dd56d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux @@ -60,9 +60,9 @@ [valueO (expression archive valueS) bodyO (expression archive bodyS)] ... TODO: Find some way to do 'let' without paying the price of the closure. - (in (_.apply/* (list valueO) - (_.lambda (list (..register register)) - bodyO))))) + (in (_.apply (list valueO) + (_.lambda (list (..register register)) + bodyO))))) (def: .public (let! statement expression archive [valueS register bodyS]) (Generator! [Synthesis Register Synthesis]) @@ -358,4 +358,4 @@ pattern_matching!)] _ (/////generation.execute! directive) _ (/////generation.save! case_artifact {.#None} directive)] - (in (_.apply/* @dependencies+ @case)))) + (in (_.apply @dependencies+ @case)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux index 077cdf100..4f959f01c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux @@ -39,7 +39,7 @@ (do [! ///////phase.monad] [functionO (expression archive functionS) argsO+ (monad.each ! (expression archive) argsS+)] - (in (_.apply/* argsO+ functionO)))) + (in (_.apply argsO+ functionO)))) (def: .public capture (-> Register SVar) @@ -64,7 +64,7 @@ (_.return @function)))] _ (/////generation.execute! directive) _ (/////generation.save! function_id {.#None} directive)] - (in (_.apply/* inits @function))))) + (in (_.apply inits @function))))) (def: input (|>> ++ //case.register)) @@ -82,7 +82,7 @@ @num_args (_.var "num_args") @self (_.var (///reference.artifact [function_module function_artifact])) apply_poly (.function (_ args func) - (_.apply/* (list (_.splat_poly args)) func)) + (_.apply (list (_.splat_poly args)) func)) initialize_self! (_.set (list (//case.register 0)) @self) initialize! (list#mix (.function (_ post pre!) (all _.then diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux index 951fcbb18..12f34891b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux @@ -105,10 +105,10 @@ actual_loop (_.return @loop) )) - (_.apply/* foreigns @loop)]))] + (_.apply foreigns @loop)]))] _ (/////generation.execute! directive) _ (/////generation.save! loop_artifact {.#None} directive)] - (in (_.apply/* initsO+ instantiation))))) + (in (_.apply initsO+ instantiation))))) (def: .public (again! statement expression archive argsS+) (Generator! (List Synthesis)) 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 1dd017309..ae9c18e2e 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 @@ -148,7 +148,7 @@ inputs)] (in (list (` (def: .public ((~ nameC) (~+ inputsC)) (-> (~+ inputs_typesC) (Computation Any)) - (_.apply/* (list (~+ inputsC)) (~ runtime_nameC)))) + (_.apply (list (~+ inputsC)) (~ runtime_nameC)))) (` (def: (~ code_nameC) (Statement Any) (..feature (~ runtime_nameC) @@ -159,7 +159,7 @@ (runtime: (lux::try op) (with_vars [exception] - (_.try (_.return (..right (_.apply/* (list ..unit) op))) + (_.try (_.return (..right (_.apply (list ..unit) op))) (list [(list "Exception") exception (_.return (..left (_.str/1 exception)))])))) @@ -167,7 +167,7 @@ (with_vars [inputs value] (all _.then (_.set (list inputs) ..none) - (<| (_.for_in value (_.apply/* (list program_args) (_.var "reversed"))) + (<| (_.for_in value (_.apply (list program_args) (_.var "reversed"))) (_.set (list inputs) (..some (_.list (list value inputs))))) (_.return inputs)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux index 677f622b1..260ca2b06 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux @@ -79,7 +79,7 @@ (in (|> bodyO _.return [(list (..register register))] (_.lambda {.#None}) - (_.apply_lambda/* (list valueO)))))) + (_.apply_lambda (list valueO)))))) (def: .public (let! statement expression archive [valueS register bodyS]) (Generator! [Synthesis Register Synthesis]) @@ -380,4 +380,4 @@ (case! true statement expression archive) (# ///////phase.monad each (|>> [(list)] (_.lambda {.#None}) - (_.apply_lambda/* (list)))))) + (_.apply_lambda (list)))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux index 45e8363c3..b8e44b9e9 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux @@ -37,7 +37,7 @@ (do [! ///////phase.monad] [functionO (expression archive functionS) argsO+ (monad.each ! (expression archive) argsS+)] - (in (_.apply_lambda/* argsO+ functionO)))) + (in (_.apply_lambda argsO+ functionO)))) (def: .public capture (-> Register LVar) @@ -59,7 +59,7 @@ (all _.then (_.set (list @self) function_definition) (_.return @self)))])) - (_.apply_lambda/* inits @self)]))) + (_.apply_lambda inits @self)]))) (def: input (|>> ++ //case.register)) @@ -106,16 +106,16 @@ arity_args (_.splat (slice (_.int +0) limitO)) output_func_args (_.splat (slice arityO @num_args))] (_.return (|> @self - (_.apply_lambda/* (list arity_args)) - (_.apply_lambda/* (list output_func_args)))))) + (_.apply_lambda (list arity_args)) + (_.apply_lambda (list output_func_args)))))) ... (|> @num_args (_.< arityO)) (let [@missing (_.local "missing")] (_.return (_.lambda {.#None} [(list (_.variadic @missing)) (_.return (|> @self - (_.apply_lambda/* (list (_.splat (|> (_.array (list)) - (_.do "concat" (list @curried) {.#None}) - (_.do "concat" (list @missing) {.#None})))))))])))) + (_.apply_lambda (list (_.splat (|> (_.array (list)) + (_.do "concat" (list @curried) {.#None}) + (_.do "concat" (list @missing) {.#None})))))))])))) )]))] _ (/////generation.execute! declaration) _ (/////generation.save! function_artifact {.#None} declaration)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux index 08ebeaf0e..e112b7817 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux @@ -77,7 +77,7 @@ [body! (scope! statement expression archive [start initsS+ bodyS])] (in (|> body! [(list)] (_.lambda {.#None}) - (_.apply_lambda/* (list))))))) + (_.apply_lambda (list))))))) (def: .public (again! statement expression archive argsS+) (Generator! (List Synthesis)) 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 2d7a0d116..f7f217580 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 @@ -136,8 +136,8 @@ inputs)] (in (list (` (def: .public ((~ g!name) (~+ inputsC)) (-> (~+ inputs_typesC) Computation) - (_.apply/* (list (~+ inputsC)) {.#None} - (~ runtime_name)))) + (_.apply (list (~+ inputsC)) {.#None} + (~ runtime_name)))) (` (def: (~ (code.local (format "@" name))) Statement @@ -253,7 +253,7 @@ (runtime: (lux//try risky) (with_vars [error value] (_.begin (all _.then - (_.set (list value) (_.apply_lambda/* (list ..unit) risky)) + (_.set (list value) (_.apply_lambda (list ..unit) risky)) (_.return (..right value))) (list [(list) error (_.return (..left (_.the "message" error)))])))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux index 9ff5b8f94..04560a891 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux @@ -34,7 +34,7 @@ (do [! ///////phase.monad] [functionO (expression archive functionS) argsO+ (monad.each ! (expression archive) argsS+)] - (in (_.apply/* argsO+ functionO)))) + (in (_.apply argsO+ functionO)))) (def: capture (-> Register Var) @@ -52,7 +52,7 @@ (_.lambda [(|> (list.enumeration inits) (list#each (|>> product.left ..capture))) {.#None}]) - (_.apply/* inits))))) + (_.apply inits))))) (def: @curried (_.var "curried")) (def: @missing (_.var "missing")) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux index b42af50f0..519d52e1a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux @@ -1,37 +1,37 @@ (.using - [library - [lux {"-" Scope} - [abstract - ["[0]" monad {"+" do}]] - [data - ["[0]" product] - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" functor)] - ["[0]" set {"+" Set}]]] - [math - [number - ["n" nat]]] - [target - ["_" scheme]]]] - ["[0]" // "_" - [runtime {"+" Operation Phase Generator}] - ["[1][0]" case] + [library + [lux {"-" Scope} + [abstract + ["[0]" monad {"+" do}]] + [data + ["[0]" product] + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" functor)] + ["[0]" set {"+" Set}]]] + [math + [number + ["n" nat]]] + [target + ["_" scheme]]]] + ["[0]" // "_" + [runtime {"+" Operation Phase Generator}] + ["[1][0]" case] + ["/[1]" // "_" + ["[1][0]" reference] ["/[1]" // "_" - ["[1][0]" reference] + [synthesis + ["[0]" case]] ["/[1]" // "_" - [synthesis - ["[0]" case]] - ["/[1]" // "_" - ["[0]"synthesis {"+" Scope Synthesis}] - ["[1][0]" generation] - ["//[1]" /// "_" - ["[1][0]" phase] - [meta - [archive {"+" Archive}]] - [reference - [variable {"+" Register}]]]]]]]) + ["[0]"synthesis {"+" Scope Synthesis}] + ["[1][0]" generation] + ["//[1]" /// "_" + ["[1][0]" phase] + [meta + [archive {"+" Archive}]] + [reference + [variable {"+" Register}]]]]]]]) (def: @scope (_.var "scope")) @@ -54,11 +54,11 @@ (list#each (|>> product.left (n.+ start) //case.register))) {.#None}] bodyO)]) - (_.apply/* initsO+ @scope)))))) + (_.apply initsO+ @scope)))))) (def: .public (again expression archive argsS+) (Generator (List Synthesis)) (do [! ///////phase.monad] [@scope /////generation.anchor argsO+ (monad.each ! (expression archive) argsS+)] - (in (_.apply/* argsO+ @scope)))) + (in (_.apply argsO+ @scope)))) 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 143ff325f..dae1bb729 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 @@ -97,7 +97,7 @@ inputs)] (in (list (` (def: .public ((~ g!name) (~+ inputsC)) (-> (~+ inputs_typesC) _.Computation) - (_.apply/* (list (~+ inputsC)) (~ runtime_name)))) + (_.apply (list (~+ inputsC)) (~ runtime_name)))) (` (def: (~ (code.local (format "@" name))) _.Computation @@ -217,7 +217,7 @@ (_.lambda [(list error) {.#None}] (..left error)) (_.lambda [(list) {.#None}] - (..right (_.apply/* (list ..unit) op)))))) + (..right (_.apply (list ..unit) op)))))) (runtime: (lux//program_args program_args) (with_vars [@loop @input @output] -- cgit v1.2.3