diff options
Diffstat (limited to '')
27 files changed, 262 insertions, 179 deletions
diff --git a/stdlib/source/lux/control/parser/synthesis.lux b/stdlib/source/lux/control/parser/synthesis.lux index 5384dc31f..0e42618f6 100644 --- a/stdlib/source/lux/control/parser/synthesis.lux +++ b/stdlib/source/lux/control/parser/synthesis.lux @@ -137,7 +137,7 @@ (exception.throw ..cannot-parse input)))) (def: #export (function expected parser) - (All [a] (-> Arity (Parser a) (Parser [Environment a]))) + (All [a] (-> Arity (Parser a) (Parser [(Environment Synthesis) a]))) (.function (_ input) (case input (^ (list& (/.function/abstraction [environment actual body]) tail)) diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux index ed038a709..8a5157b4a 100644 --- a/stdlib/source/lux/data/binary.lux +++ b/stdlib/source/lux/data/binary.lux @@ -248,9 +248,11 @@ (as-is)} ## Default - (exception: #export (cannot-copy-bytes {source-input Nat} + (exception: #export (cannot-copy-bytes {bytes Nat} + {source-input Nat} {target-output Nat}) (exception.report + ["Bytes" (%.nat bytes)] ["Source input space" (%.nat source-input)] ["Target output space" (%.nat target-output)]))) @@ -268,15 +270,15 @@ ## Default (let [source-input (n.- source-offset (!size source)) target-output (n.- target-offset (!size target))] - (if (n.<= source-input target-output) + (if (n.<= source-input bytes) (loop [idx 0] - (if (n.< target-output idx) + (if (n.< bytes idx) (exec (!write (n.+ target-offset idx) (!read (n.+ source-offset idx) source) target) (recur (inc idx))) (#try.Success target))) - (exception.throw ..cannot-copy-bytes [source-input target-output])))))) + (exception.throw ..cannot-copy-bytes [bytes source-input target-output])))))) (def: #export (slice from to binary) (-> Nat Nat Binary (Try Binary)) diff --git a/stdlib/source/lux/data/collection/dictionary.lux b/stdlib/source/lux/data/collection/dictionary.lux index c4c8efeb1..61c82c49b 100644 --- a/stdlib/source/lux/data/collection/dictionary.lux +++ b/stdlib/source/lux/data/collection/dictionary.lux @@ -341,7 +341,7 @@ ## However, if the BitPosition has not been used yet, I check ## whether this #Base node is ready for a promotion. (let [base-count (bitmap-size bitmap)] - (if (n.>= promotion-threshold base-count) + (if (n.>= ..promotion-threshold base-count) ## If so, I promote it to a #Hierarchy node, and add the new ## KV-pair as a singleton node to it. (#Hierarchy (inc base-count) diff --git a/stdlib/source/lux/data/number/i64.lux b/stdlib/source/lux/data/number/i64.lux index 97e897cc5..a9b1afb3b 100644 --- a/stdlib/source/lux/data/number/i64.lux +++ b/stdlib/source/lux/data/number/i64.lux @@ -2,6 +2,7 @@ [lux (#- and or not) [abstract [equivalence (#+ Equivalence)] + [hash (#+ Hash)] [monoid (#+ Monoid)]] [data [number @@ -110,6 +111,13 @@ (def: (= parameter subject) ("lux i64 =" parameter subject))) +(structure: #export hash + (All [a] (Hash (I64 a))) + + (def: &equivalence ..equivalence) + + (def: hash .nat)) + (structure: #export disjunction (All [a] (Monoid (I64 a))) diff --git a/stdlib/source/lux/data/sum.lux b/stdlib/source/lux/data/sum.lux index a40aa4619..6a048153c 100644 --- a/stdlib/source/lux/data/sum.lux +++ b/stdlib/source/lux/data/sum.lux @@ -2,7 +2,8 @@ {#.doc "Functionality for working with variants (particularly 2-variants)."} [lux #* [abstract - [equivalence (#+ Equivalence)]]]) + [equivalence (#+ Equivalence)] + [hash (#+ Hash)]]]) (template [<name> <type> <right?>] [(def: #export (<name> value) @@ -73,3 +74,20 @@ _ false))) + +(structure: #export (hash (^open "l@.") (^open "r@.")) + (All [l r] + (-> (Hash l) (Hash r) + (Hash (| l r)))) + + (def: &equivalence (..equivalence l@= r@=)) + + (def: (hash value) + (case value + (#.Left value) + (l@hash value) + + (#.Right value) + (.nat ("lux i64 *" + (.int 2) + (.int (r@hash value))))))) diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux index 0e9aa8f79..7fcf3e9c6 100644 --- a/stdlib/source/lux/time/date.lux +++ b/stdlib/source/lux/time/date.lux @@ -7,10 +7,10 @@ codec [monad (#+ do)]] [control + ["." try] ["p" parser ("#@." functor) ["l" text (#+ Parser)]]] [data - ["." maybe] [number ["n" nat ("#@." decimal)] ["i" int ("#@." decimal)]] @@ -105,7 +105,7 @@ (Row Nat) (|> common-months (row.update 1 inc) - maybe.assume)) + try.assume)) (def: (divisible? factor input) (-> Int Int Bit) @@ -144,7 +144,7 @@ common-months) month-days (|> months (row.nth (.nat (dec utc-month))) - maybe.assume)] + try.assume)] _ (l.this "-") utc-day lex-section _ (p.assert "Invalid day." diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux index 297fc7075..ea62e77fb 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux @@ -84,15 +84,15 @@ (type: #export (Match' e) [(Branch' e) (List (Branch' e))]) -(type: #export Environment - (List Variable)) +(type: #export (Environment a) + (List a)) (type: #export #rec Analysis (#Primitive Primitive) (#Structure (Composite Analysis)) (#Reference Reference) (#Case Analysis (Match' Analysis)) - (#Function Environment Analysis) + (#Function (Environment Analysis) Analysis) (#Apply Analysis Analysis) (#Extension (Extension Analysis))) @@ -186,7 +186,7 @@ [(#Function [reference-environment reference-analysis]) (#Function [sample-environment sample-analysis])] (and (= reference-analysis sample-analysis) - (:: (list.equivalence variable.equivalence) = reference-environment sample-environment)) + (:: (list.equivalence =) = reference-environment sample-environment)) [(#Apply [reference-input reference-abstraction]) (#Apply [sample-input sample-abstraction])] @@ -222,7 +222,7 @@ ) (type: #export (Abstraction c) - [Environment Arity c]) + [(Environment c) Arity c]) (type: #export (Application c) [c (List c)]) @@ -344,7 +344,7 @@ (|> (%analysis body) (format " ") (format (|> environment - (list@map variable.format) + (list@map %analysis) (text.join-with " ") (text.enclose ["[" "]"]))) (text.enclose ["(" ")"])) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux index 16bfb7c84..8426c7577 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -22,7 +22,9 @@ [// ["/" analysis (#+ Analysis Operation Phase)] [/// - ["#" phase]]]]]) + ["#" phase] + [reference (#+) + [variable (#+)]]]]]]) (exception: #export (cannot-analyse {expected Type} {function Text} {argument Text} {body Code}) (ex.report ["Type" (%.type expected)] @@ -87,7 +89,9 @@ (#.Function inputT outputT) (<| (:: @ map (.function (_ [scope bodyA]) - (#/.Function (//scope.environment scope) bodyA))) + (#/.Function (list@map (|>> /.variable) + (//scope.environment scope)) + bodyA))) /.with-scope ## Functions have access not only to their argument, but ## also to themselves, through a local variable. diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 77b9e0b8a..4735f8d3f 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -1614,7 +1614,8 @@ (/////analysis.tuple (list@map class-analysis exceptions)) (/////analysis.tuple (list@map typed-analysis super-arguments)) (#/////analysis.Function - (scope.environment scope) + (list@map (|>> /////analysis.variable) + (scope.environment scope)) (/////analysis.tuple (list bodyA))) )))))) @@ -1691,7 +1692,8 @@ (return-analysis return) (/////analysis.tuple (list@map class-analysis exceptions)) (#/////analysis.Function - (scope.environment scope) + (list@map (|>> /////analysis.variable) + (scope.environment scope)) (/////analysis.tuple (list bodyA))) )))))) @@ -1762,7 +1764,8 @@ (/////analysis.tuple (list@map class-analysis exceptions)) (#/////analysis.Function - (scope.environment scope) + (list@map (|>> /////analysis.variable) + (scope.environment scope)) (/////analysis.tuple (list bodyA))) )))))) @@ -1838,7 +1841,8 @@ (/////analysis.tuple (list@map class-analysis exceptions)) (#/////analysis.Function - (scope.environment scope) + (list@map (|>> /////analysis.variable) + (scope.environment scope)) (/////analysis.tuple (list bodyA))) )))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index dd428c7dc..690efdcf3 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -24,9 +24,7 @@ ["#." bundle] ["/#" // #_ [analysis - [".A" type] - [".A" case] - [".A" function]] + [".A" type]] [// ["#." analysis (#+ Analysis Operation Phase Handler Bundle) [evaluation (#+ Eval)]] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux index 16e5e5996..514df447c 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux @@ -28,7 +28,7 @@ (def: array::new (Unary Expression) - (|>> //runtime.i64//to-number list (_.new (_.var "Array")))) + (|>> (_.the //runtime.i64-low-field) list (_.new (_.var "Array")))) (def: array::length (Unary Expression) @@ -36,7 +36,8 @@ (def: (array::read [indexG arrayG]) (Binary Expression) - (_.at indexG arrayG)) + (_.at (_.the //runtime.i64-low-field indexG) + arrayG)) (def: (array::write [indexG valueG arrayG]) (Trinary Expression) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux index 834a7bc07..0737d9772 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -825,7 +825,7 @@ (<s>.tuple (<>.and <s>.text ..value))) (def: overriden-method-definition - (Parser [Environment (/.Overriden-Method Synthesis)]) + (Parser [(Environment Synthesis) (/.Overriden-Method Synthesis)]) (<s>.tuple (do <>.monad [_ (<s>.text! /.overriden-tag) ownerT ..class @@ -910,10 +910,17 @@ (//////synthesis.loop/recur (list@map recur updatesS+)) (^ (//////synthesis.function/abstraction [environment arity bodyS])) - (//////synthesis.function/abstraction [(|> environment (list@map (function (_ local) - (|> mapping - (dictionary.get local) - (maybe.default local))))) + (//////synthesis.function/abstraction [(list@map (function (_ local) + (case local + (^ (//////synthesis.variable local)) + (|> mapping + (dictionary.get local) + (maybe.default local) + //////synthesis.variable) + + _ + local)) + environment) arity bodyS]) @@ -926,13 +933,13 @@ (def: $Object (type.class "java.lang.Object" (list))) (def: (anonymous-init-method env) - (-> Environment (Type category.Method)) + (-> (Environment Synthesis) (Type category.Method)) (type.method [(list.repeat (list.size env) ..$Object) type.void (list)])) (def: (with-anonymous-init class env super-class inputsTG) - (-> (Type category.Class) Environment (Type category.Class) (List (Typed (Bytecode Any))) (Resource Method)) + (-> (Type category.Class) (Environment Synthesis) (Type category.Class) (List (Typed (Bytecode Any))) (Resource Method)) (let [store-capturedG (|> env list.size list.indices @@ -950,10 +957,10 @@ store-capturedG _.return))))) -(def: (anonymous-instance archive class env) - (-> Archive (Type category.Class) Environment (Operation (Bytecode Any))) +(def: (anonymous-instance generate archive class env) + (-> Phase Archive (Type category.Class) (Environment Synthesis) (Operation (Bytecode Any))) (do {@ //////.monad} - [captureG+ (monad.map @ (///reference.variable archive) env)] + [captureG+ (monad.map @ (generate archive) env)] (wrap ($_ _.compose (_.new class) _.dup @@ -1012,7 +1019,7 @@ ## Combine them. list@join ## Remove duplicates. - (set.from-list //////variable.hash) + (set.from-list //////synthesis.hash) set.to-list) global-mapping (|> total-environment ## Give them names as "foreign" variables. @@ -1073,7 +1080,7 @@ (row.row))) _ (//////generation.save! true ["" (%.nat artifact-id)] [anonymous-class-name bytecode])] - (anonymous-instance archive class total-environment)))])) + (anonymous-instance generate archive class total-environment)))])) (def: bundle::class Bundle diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux index 3b491fd8e..91689340f 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux @@ -19,7 +19,7 @@ ["/#" // #_ ["#." reference] ["//#" /// #_ - [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)] + [analysis (#+ Variant Tuple Abstraction Application Analysis)] [synthesis (#+ Synthesis)] ["#." generation (#+ Context)] ["//#" /// #_ @@ -83,8 +83,9 @@ pre! (_.define (..input post) (_.at (_.i32 (.int post)) @@arguments)))) initialize-self! - (list.indices arity)) - [definition instantiation] (with-closure @self (list@map (///reference.variable //reference.system) environment) + (list.indices arity))] + environment (monad.map @ (expression archive) environment) + #let [[definition instantiation] (with-closure @self environment ($_ _.then (_.define @num-args (_.the "length" @@arguments)) (_.cond (list [(|> @num-args (_.= arityO)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux index 40322f88b..ed7cdc5ff 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux @@ -10,7 +10,7 @@ ["." product] [number (#+ hex) ["." i64]] - ["." text + ["." text ("#@." hash) ["%" format (#+ format)] ["." encoding]] [collection @@ -20,7 +20,12 @@ ["." code] [syntax (#+ syntax:)]] [target - ["_" js (#+ Expression Var Computation Statement)]]] + ["_" js (#+ Expression Var Computation Statement)]] + [tool + [compiler + [language + [lux + ["$" version]]]]]] ["." /// #_ ["#." reference] ["//#" /// #_ @@ -32,8 +37,7 @@ [variable (#+ Register)]] [meta [archive (#+ Archive) - ["." artifact (#+ Registry)]]]]]] - ) + ["." artifact (#+ Registry)]]]]]]) (template [<name> <base>] [(type: #export <name> @@ -117,41 +121,57 @@ list.concat))] (~ body))))))) +(def: (runtime-name name) + (-> Text [Code Code]) + (let [identifier (format ..prefix + "_" (%.nat $.version) + "_" (%.nat (text@hash name)))] + [(` (_.var (~ (code.text identifier)))) + (code.local-identifier identifier)])) + (syntax: (runtime: {declaration (p.or s.local-identifier (s.form (p.and s.local-identifier (p.some s.local-identifier))))} code) - (do macro.monad - [id macro.count - #let [identifier (format ..prefix (%.nat id)) - runtime-nameC (` (_.var (~ (code.text identifier))))]] - (case declaration - (#.Left name) - (macro.with-gensyms [g!_] - (let [nameC (code.local-identifier name)] - (wrap (list (` (def: #export (~ nameC) Var (~ runtime-nameC))) - (` (def: (~ (code.local-identifier (format "@" name))) - Statement - (..feature (~ runtime-nameC) - (function ((~ g!_) (~ nameC)) - (~ code))))))))) - - (#.Right [name inputs]) - (macro.with-gensyms [g!_] - (let [nameC (code.local-identifier name) - code-nameC (code.local-identifier (format "@" name)) - inputsC (list@map code.local-identifier inputs) - inputs-typesC (list@map (function.constant (` _.Expression)) inputs)] - (wrap (list (` (def: #export ((~ nameC) (~+ inputsC)) - (-> (~+ inputs-typesC) Computation) - (_.apply/* (~ runtime-nameC) (list (~+ inputsC))))) - (` (def: (~ (code.local-identifier (format "@" name))) - Statement - (..feature (~ runtime-nameC) - (function ((~ g!_) (~ g!_)) - (..with-vars [(~+ inputsC)] - (_.function (~ g!_) (list (~+ inputsC)) - (~ code)))))))))))))) + (case declaration + (#.Left name) + (macro.with-gensyms [g!_] + (let [[runtime-nameC runtime-nameC!] (..runtime-name name) + nameC (code.local-identifier name)] + (wrap (list (` (def: (~ runtime-nameC!) + Var + (~ runtime-nameC))) + + (` (def: #export (~ nameC) + (~ runtime-nameC!))) + + (` (def: (~ (code.local-identifier (format "@" name))) + Statement + (..feature (~ runtime-nameC) + (function ((~ g!_) (~ nameC)) + (~ code))))))))) + + (#.Right [name inputs]) + (macro.with-gensyms [g!_] + (let [[runtime-nameC runtime-nameC!] (..runtime-name name) + nameC (code.local-identifier name) + code-nameC (code.local-identifier (format "@" name)) + inputsC (list@map code.local-identifier inputs) + inputs-typesC (list@map (function.constant (` _.Expression)) inputs)] + (wrap (list (` (def: ((~ runtime-nameC!) (~+ inputsC)) + (-> (~+ inputs-typesC) Computation) + (_.apply/* (~ runtime-nameC) (list (~+ inputsC))))) + + (` (def: #export (~ nameC) + (~ runtime-nameC!))) + + (` (def: (~ (code.local-identifier (format "@" name))) + Statement + (..feature (~ runtime-nameC) + (function ((~ g!_) (~ g!_)) + (..with-vars [(~+ inputsC)] + (_.function (~ g!_) (list (~+ inputsC)) + (~ code))))))))))))) (runtime: (lux//try op) (with-vars [ex] @@ -715,12 +735,12 @@ (runtime: (array//write idx value array) ($_ _.then - (_.set (_.at idx array) value) + (_.set (_.at (_.the ..i64-low-field idx) array) value) (_.return array))) (runtime: (array//delete idx array) ($_ _.then - (_.delete (_.at idx array)) + (_.delete (_.at (_.the ..i64-low-field idx) array)) (_.return array))) (def: runtime//array @@ -732,7 +752,6 @@ (def: runtime Statement ($_ _.then - _.use-strict runtime//lux runtime//structure runtime//i64 diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux index 4359d7815..5c39d5d32 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux @@ -57,8 +57,8 @@ [reference [variable (#+ Register)]]]]]]) -(def: #export (with archive @begin class environment arity body) - (-> Archive Label External Environment Arity (Bytecode Any) +(def: #export (with generate archive @begin class environment arity body) + (-> Phase Archive Label External (Environment Synthesis) Arity (Bytecode Any) (Operation [(List (Resource Field)) (List (Resource Method)) (Bytecode Any)])) @@ -77,7 +77,7 @@ (list& (/implementation.method arity @begin body))) (list (/implementation.method' //runtime.apply::name arity @begin body)))))] (do phase.monad - [instance (/new.instance archive classT environment arity)] + [instance (/new.instance generate archive classT environment arity)] (wrap [fields methods instance])))) (def: modifier @@ -102,7 +102,7 @@ (generation.with-anchor [@begin ..this-offset] (generate archive bodyS))) #let [function-class (//runtime.class-name function-context)] - [fields methods instance] (..with archive @begin function-class environment arity bodyG) + [fields methods instance] (..with generate archive @begin function-class environment arity bodyG) class (phase.lift (class.class version.v6_0 ..modifier (name.internal function-class) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/foreign.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/foreign.lux index 14b4f6cab..cbea98db2 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/foreign.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/foreign.lux @@ -17,12 +17,13 @@ ["#." reference] [//// [analysis (#+ Environment)] + [synthesis (#+ Synthesis)] [/// [reference [variable (#+ Register)]]]]]]) (def: #export (closure environment) - (-> Environment (List (Type Value))) + (-> (Environment Synthesis) (List (Type Value))) (list.repeat (list.size environment) //.type)) (def: #export (get class register) @@ -34,5 +35,5 @@ (//.put /////reference.foreign-name class register value)) (def: #export variables - (-> Environment (List (Resource Field))) + (-> (Environment Synthesis) (List (Resource Field))) (|>> list.size (//.variables /////reference.foreign-name))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux index cafb6ceeb..095c07dc2 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux @@ -40,6 +40,7 @@ ["#." reference] [//// [analysis (#+ Environment)] + [synthesis (#+ Synthesis)] [/// [arity (#+ Arity)] [reference @@ -76,7 +77,7 @@ (def: this-offset 1) (def: #export (method class environment function-arity @begin body apply-arity) - (-> (Type Class) Environment Arity Label (Bytecode Any) Arity (Resource Method)) + (-> (Type Class) (Environment Synthesis) Arity Label (Bytecode Any) Arity (Resource Method)) (let [num-partials (dec function-arity) over-extent (i.- (.int apply-arity) (.int function-arity))] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux index cf1ad20df..8649123ff 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux @@ -34,6 +34,7 @@ ["#." reference] [//// [analysis (#+ Environment)] + [synthesis (#+ Synthesis)] [/// ["." arity (#+ Arity)] [reference @@ -46,7 +47,7 @@ (list.repeat (dec arity) ////type.value)) (def: #export (type environment arity) - (-> Environment Arity (Type category.Method)) + (-> (Environment Synthesis) Arity (Type category.Method)) (type.method [(list@compose (///foreign.closure environment) (if (arity.multiary? arity) (list& ///arity.type (..partials arity)) @@ -77,7 +78,7 @@ (monad.seq _.monad))) (def: #export (method class environment arity) - (-> (Type Class) Environment Arity (Resource Method)) + (-> (Type Class) (Environment Synthesis) Arity (Resource Method)) (let [environment-size (list.size environment) offset-foreign (: (-> Register Register) (n.+ 1)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux index ab8f4f911..a36289d05 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux @@ -32,17 +32,18 @@ ["#." foreign] ["#." partial]]] ["/#" // #_ - [runtime (#+ Operation)] + [runtime (#+ Operation Phase)] ["#." value] ["#." reference] [//// [analysis (#+ Environment)] + [synthesis (#+ Synthesis)] [/// ["." arity (#+ Arity)] ["." phase]]]]]]) (def: #export (instance' foreign-setup class environment arity) - (-> (List (Bytecode Any)) (Type Class) Environment Arity (Bytecode Any)) + (-> (List (Bytecode Any)) (Type Class) (Environment Synthesis) Arity (Bytecode Any)) ($_ _.compose (_.new class) _.dup @@ -50,14 +51,14 @@ (///partial.new arity) (_.invokespecial class //init.name (//init.type environment arity)))) -(def: #export (instance archive class environment arity) - (-> Archive (Type Class) Environment Arity (Operation (Bytecode Any))) +(def: #export (instance generate archive class environment arity) + (-> Phase Archive (Type Class) (Environment Synthesis) Arity (Operation (Bytecode Any))) (do {@ phase.monad} - [foreign* (monad.map @ (////reference.variable archive) environment)] + [foreign* (monad.map @ (generate archive) environment)] (wrap (instance' foreign* class environment arity)))) (def: #export (method class environment arity) - (-> (Type Class) Environment Arity (Resource Method)) + (-> (Type Class) (Environment Synthesis) Arity (Resource Method)) (let [after-this (: (-> Nat Nat) (n.+ 1)) environment-size (list.size environment) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux index 66cdda752..7373bf984 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux @@ -21,6 +21,7 @@ ["#." reference] [//// [analysis (#+ Environment)] + [synthesis (#+ Synthesis)] [/// ["." arity (#+ Arity)]]]]]]) @@ -31,13 +32,13 @@ (type.method [(list) class (list)])) (def: (current-environment class) - (-> (Type Class) Environment (List (Bytecode Any))) + (-> (Type Class) (Environment Synthesis) (List (Bytecode Any))) (|>> list.size list.indices (list@map (///foreign.get class)))) (def: #export (method class environment arity) - (-> (Type Class) Environment Arity (Resource Method)) + (-> (Type Class) (Environment Synthesis) Arity (Resource Method)) (method.method //.modifier ..name (..type class) (list) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux index 5951cee48..d7225ca48 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -363,11 +363,7 @@ (list@fold for-synthesis synthesis-storage (#.Cons functionS argsS)) (^ (/.function/abstraction [environment arity bodyS])) - (list@fold (function (_ variable storage) - (for-synthesis (#/.Reference (#///reference.Variable variable)) - storage)) - synthesis-storage - environment) + (list@fold for-synthesis synthesis-storage environment) (^ (/.branch/let [inputS register exprS])) (list@fold for-synthesis diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux index 8fc87bcc2..ea15e4b24 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -3,6 +3,7 @@ [abstract ["." monad (#+ do)]] [control + [pipe (#+ case>)] ["." exception (#+ exception:)]] [data ["." maybe ("#@." functor)] @@ -23,12 +24,10 @@ ["#/." variable (#+ Register Variable)]] ["." phase ("#@." monad)]]]]) -(exception: #export (cannot-find-foreign-variable-in-environment {foreign Register} {environment Environment}) +(exception: #export (cannot-find-foreign-variable-in-environment {foreign Register} {environment (Environment Synthesis)}) (exception.report ["Foreign" (%.nat foreign)] - ["Environment" (|> environment - (list@map ////reference/variable.format) - (text.join-with " "))])) + ["Environment" (exception.enumerate /.%synthesis environment)])) (def: arity-arguments (-> Arity (List Synthesis)) @@ -80,7 +79,7 @@ (wrap <apply>))))))) (def: (find-foreign environment register) - (-> Environment Register (Operation Variable)) + (-> (Environment Synthesis) Register (Operation Synthesis)) (case (list.nth register environment) (#.Some aliased) (phase@wrap aliased) @@ -135,20 +134,8 @@ _ (phase@wrap path))) -(def: (grow-sub-environment super sub) - (-> Environment Environment (Operation Environment)) - (monad.map phase.monad - (function (_ variable) - (case variable - (#////reference/variable.Local register) - (phase@wrap (#////reference/variable.Local (inc register))) - - (#////reference/variable.Foreign register) - (find-foreign super register))) - sub)) - (def: (grow environment expression) - (-> Environment Synthesis (Operation Synthesis)) + (-> (Environment Synthesis) Synthesis (Operation Synthesis)) (case expression (#/.Structure structure) (case structure @@ -173,9 +160,7 @@ (phase@wrap (/.variable/local (inc register))) (#////reference/variable.Foreign register) - (|> register - (find-foreign environment) - (phase@map (|>> /.variable)))) + (..find-foreign environment register)) (#////reference.Constant constant) (phase@wrap expression)) @@ -224,34 +209,42 @@ (#/.Function function) (case function (#/.Abstraction [_env _arity _body]) - (do phase.monad - [_env' (grow-sub-environment environment _env)] + (do {@ phase.monad} + [_env' (monad.map @ + (|>> (case> (#/.Reference (#////reference.Variable (#////reference/variable.Foreign register))) + (..find-foreign environment register) + + captured + (grow environment captured))) + _env)] (wrap (/.function/abstraction [_env' _arity _body]))) (#/.Apply funcS argsS+) - (case funcS - (^ (/.function/apply [(..self-reference) pre-argsS+])) - (phase@wrap (/.function/apply [(..self-reference) - (list@compose pre-argsS+ argsS+)])) - - _ - (do {@ phase.monad} - [funcS' (grow environment funcS) - argsS+' (monad.map @ (grow environment) argsS+)] - (wrap (/.function/apply [funcS' argsS+'])))))) + (do {@ phase.monad} + [funcS (grow environment funcS) + argsS+ (monad.map @ (grow environment) argsS+)] + (wrap (/.function/apply (case funcS + (^ (/.function/apply [(..self-reference) pre-argsS+])) + [(..self-reference) + (list@compose pre-argsS+ argsS+)] + + _ + [funcS + argsS+])))))) (#/.Extension name argumentsS+) (|> argumentsS+ (monad.map phase.monad (grow environment)) (phase@map (|>> (#/.Extension name)))) - _ + (#/.Primitive _) (phase@wrap expression))) (def: #export (abstraction phase environment archive bodyA) - (-> Phase Environment Phase) + (-> Phase (Environment Analysis) Phase) (do {@ phase.monad} [currying? /.currying? + environment (monad.map @ (phase archive) environment) bodyS (/.with-currying? true (/.with-locals 2 (phase archive bodyA))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux index e2e4e4db5..064aca2a7 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux @@ -23,22 +23,6 @@ (-> Register (-> Register Register)) (|>> dec (n.+ offset))) -(def: (variable-optimization true-loop? offset environment variable) - (-> Bit Register Environment (Transform Variable)) - (case variable - (^ (variable.self)) - (if true-loop? - #.None - (#.Some variable)) - - (#variable.Foreign register) - (if true-loop? - (list.nth register environment) - (#.Some variable)) - - (#variable.Local register) - (#.Some (#variable.Local (register-optimization offset register))))) - (def: (path-optimization body-optimization offset) (-> (Transform Synthesis) Register (Transform Path)) (function (recur path) @@ -88,7 +72,7 @@ (#.Some path)))) (def: (body-optimization true-loop? offset scope-environment arity expr) - (-> Bit Register Environment Arity (Transform Synthesis)) + (-> Bit Register (Environment Synthesis) Arity (Transform Synthesis)) (loop [return? true expr expr] (case expr @@ -124,9 +108,7 @@ (^ (reference.foreign register)) (if true-loop? - (|> scope-environment - (list.nth register) - (maybe@map (|>> /.variable))) + (list.nth register scope-environment) (#.Some expr))) (^ (/.branch/case [input path])) @@ -170,8 +152,7 @@ (^ (/.function/abstraction [environment arity body])) (do {@ maybe.monad} - [environment' (monad.map @ (variable-optimization true-loop? offset scope-environment) - environment)] + [environment' (monad.map @ (recur false) environment)] (wrap (/.function/abstraction [environment' arity body]))) (^ (/.function/apply [abstraction arguments])) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux index 1ba1388d6..6b67ba5aa 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux @@ -155,7 +155,7 @@ (#/.Function function) (#/.Function (case function (#/.Abstraction [environment arity body]) - (#/.Abstraction [(list@map (..remove-local-from-variable redundant) environment) + (#/.Abstraction [(list@map recur environment) arity body]) @@ -319,15 +319,6 @@ (wrap [redundancy (#/.Then then)])) ))) -(def: (variable-optimization variable redundancy) - (-> Variable Redundancy (Try Redundancy)) - (case variable - (#variable.Local register) - (..observe register redundancy) - - (#variable.Foreign register) - (#try.Success redundancy))) - (def: (optimization' [redundancy synthesis]) (Optimization Synthesis) (with-expansions [<no-op> (as-is (#try.Success [redundancy @@ -425,7 +416,7 @@ (case function (#/.Abstraction [environment arity body]) (do {@ try.monad} - [redundancy (monad.fold @ ..variable-optimization redundancy environment) + [[redundancy environment] (..list-optimization optimization' [redundancy environment]) [_ body] (optimization' [(..default arity) body])] (wrap [redundancy (#/.Control (#/.Function (#/.Abstraction [environment arity body])))])) diff --git a/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux b/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux index 4c3953efe..12be82b11 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux @@ -2,8 +2,10 @@ [lux (#- i64 Scope) [abstract [monad (#+ do)] + [hash (#+ Hash)] ["." equivalence (#+ Equivalence)]] [control + [pipe (#+ case>)] ["." exception (#+ exception:)]] [data ["." sum] @@ -78,7 +80,7 @@ (#Then s)) (type: #export (Abstraction' s) - {#environment Environment + {#environment (Environment s) #arity Arity #body s}) @@ -348,7 +350,7 @@ (case function (#Abstraction [environment arity body]) (let [environment' (|> environment - (list@map variable.format) + (list@map %synthesis) (text.join-with " ") (text.enclose ["[" "]"]))] (|> (format environment' " " (%.nat arity) " " (%synthesis body)) @@ -426,6 +428,20 @@ _ false))) +(structure: primitive-hash + (Hash Primitive) + + (def: &equivalence ..primitive-equivalence) + + (def: hash + (|>> (case> (^template [<tag> <hash>] + (<tag> value') + (:: <hash> hash value')) + ([#Bit bit.hash] + [#F64 f.hash] + [#Text text.hash] + [#I64 i64.hash]))))) + (def: side-equivalence (Equivalence Side) (sum.equivalence n.equivalence n.equivalence)) @@ -448,6 +464,20 @@ _ false))) +(structure: access-hash + (Hash Access) + + (def: &equivalence ..access-equivalence) + + (def: (hash value) + (let [sub-hash (sum.hash n.hash n.hash)] + (case value + (^template [<tag>] + (<tag> value) + (:: sub-hash hash value)) + ([#Side] + [#Member]))))) + (structure: #export (path'-equivalence equivalence) (All [a] (-> (Equivalence a) (Equivalence (Path' a)))) @@ -545,7 +575,7 @@ (case [reference sample] [(#Abstraction [reference-environment reference-arity reference-body]) (#Abstraction [sample-environment sample-arity sample-body])] - (and (:: (list.equivalence variable.equivalence) = reference-environment sample-environment) + (and (:: (list.equivalence /@=) = reference-environment sample-environment) (n.= reference-arity sample-arity) (/@= reference-body sample-body)) @@ -593,6 +623,26 @@ (Equivalence Path) (path'-equivalence equivalence)) +## (structure: #export hash +## (Hash Synthesis) + +## (def: &equivalence ..equivalence) + +## (def: (hash value) +## (case value +## (case [reference sample] +## (^template [<tag> <hash>] +## [(<tag> value')] +## (:: <hash> hash value')) +## ([#Primitive ..primitive-hash] +## [#Structure (analysis.composite-hash hash)] +## [#Reference reference.hash] +## [#Control (control-hash hash)] +## [#Extension (extension.hash hash)]) + +## _ +## false)))) + (template: #export (!bind-top register thenP) ($_ ..path/seq (#..Bind register) diff --git a/stdlib/source/lux/tool/compiler/language/lux/version.lux b/stdlib/source/lux/tool/compiler/language/lux/version.lux index 53b3424ae..5f3c7c9d0 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/version.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/version.lux @@ -1,8 +1,11 @@ (.module: - [lux #*] + [lux #* + ["@" target]] [//// [version (#+ Version)]]) (def: #export version Version - 00,06,00) + (for {@.old + 00,05,99} + 00,06,00)) diff --git a/stdlib/source/test/lux/control/parser/synthesis.lux b/stdlib/source/test/lux/control/parser/synthesis.lux index 5dbf6a383..1896d4ca4 100644 --- a/stdlib/source/test/lux/control/parser/synthesis.lux +++ b/stdlib/source/test/lux/control/parser/synthesis.lux @@ -27,7 +27,7 @@ [language [lux [analysis (#+ Environment)] - ["." synthesis]]]]]] + ["." synthesis (#+ Synthesis)]]]]]] {1 ["." /]}) @@ -50,10 +50,12 @@ random.nat)) (def: random-environment - (Random Environment) + (Random (Environment Synthesis)) (do {@ random.monad} [size (:: @ map (n.% 5) random.nat)] - (random.list size ..random-variable))) + (|> ..random-variable + (:: @ map (|>> synthesis.variable)) + (random.list size)))) (def: #export test Test @@ -145,7 +147,7 @@ (and (|> (/.run (/.function arity /.text) (list (synthesis.function/abstraction [expected-environment arity (synthesis.text expected-body)]))) (!expect (^multi (#try.Success [actual-environment actual-body]) - (and (:: (list.equivalence variable.equivalence) = + (and (:: (list.equivalence synthesis.equivalence) = expected-environment actual-environment) (:: text.equivalence = expected-body actual-body))))) |