diff options
Diffstat (limited to 'stdlib/source/lux/tool/compiler/phase')
32 files changed, 227 insertions, 227 deletions
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/case.lux b/stdlib/source/lux/tool/compiler/phase/analysis/case.lux index 2970364a0..a2864e784 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/case.lux @@ -10,7 +10,7 @@ [text format] [collection - ["." list ("#/." fold monoid functor)]]] + ["." list ("#;." fold monoid functor)]]] ["." type ["." check]] ["." macro @@ -119,7 +119,7 @@ (#.Product _) (|> caseT type.flatten-tuple - (list/map (re-quantify envs)) + (list;map (re-quantify envs)) type.tuple (:: ///.monad wrap)) @@ -188,16 +188,16 @@ num-sub-patterns (list.size sub-patterns) matches (cond (n/< num-subs num-sub-patterns) (let [[prefix suffix] (list.split (dec num-sub-patterns) subs)] - (list.zip2 (list/compose prefix (list (type.tuple suffix))) sub-patterns)) + (list.zip2 (list;compose prefix (list (type.tuple suffix))) sub-patterns)) (n/> num-subs num-sub-patterns) (let [[prefix suffix] (list.split (dec num-subs) sub-patterns)] - (list.zip2 subs (list/compose prefix (list (code.tuple suffix))))) + (list.zip2 subs (list;compose prefix (list (code.tuple suffix))))) ## (n/= num-subs num-sub-patterns) (list.zip2 subs sub-patterns))] (do @ - [[memberP+ thenA] (list/fold (: (All [a] + [[memberP+ thenA] (list;fold (: (All [a] (-> [Type Code] (Operation [(List Pattern) a]) (Operation [(List Pattern) a]))) (function (_ [memberT memberC] then) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux b/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux index 24dd3051a..cb7cc07ef 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux @@ -5,17 +5,17 @@ ["ex" exception (#+ exception:)] equivalence] [data - ["." bit ("#/." equivalence)] - ["." error (#+ Error) ("#/." monad)] + ["." bit ("#;." equivalence)] + ["." error (#+ Error) ("#;." monad)] ["." maybe] [number ["." nat]] ["." text format] [collection - ["." list ("#/." functor fold)] + ["." list ("#;." functor fold)] ["." dictionary (#+ Dictionary)]]]] - ["." //// ("#/." monad) + ["." //// ("#;." monad) [// ["/" analysis (#+ Pattern Variant Operation)]]]) @@ -73,7 +73,7 @@ (#Variant ?max-cases cases) (|> cases dictionary.entries - (list/map (function (_ [idx coverage]) + (list;map (function (_ [idx coverage]) (format (%n idx) " " (%coverage coverage)))) (text.join-with " ") (text.enclose ["{" "}"]) @@ -94,13 +94,13 @@ (case pattern (^or (#/.Simple #/.Unit) (#/.Bind _)) - (/////wrap #Exhaustive) + (////;wrap #Exhaustive) ## Primitive patterns always have partial coverage because there ## are too many possibilities as far as values go. (^template [<tag>] (#/.Simple (<tag> _)) - (/////wrap #Partial)) + (////;wrap #Partial)) ([#/.Nat] [#/.Int] [#/.Rev] @@ -111,7 +111,7 @@ ## "#0", which means it is possible for bit ## pattern-matching to become exhaustive if complementary parts meet. (#/.Simple (#/.Bit value)) - (/////wrap (#Bit value)) + (////;wrap (#Bit value)) ## Tuple patterns can be exhaustive if there is exhaustiveness for all of ## their sub-patterns. @@ -180,7 +180,7 @@ #1 [(#Bit sideR) (#Bit sideS)] - (bit/= sideR sideS) + (bit;= sideR sideS) [(#Variant allR casesR) (#Variant allS casesS)] (and (n/= (cases allR) @@ -216,12 +216,12 @@ (-> Coverage Coverage (Error Coverage)) (case [addition so-far] [#Partial #Partial] - (error/wrap #Partial) + (error;wrap #Partial) ## 2 bit coverages are exhaustive if they complement one another. (^multi [(#Bit sideA) (#Bit sideSF)] (xor sideA sideSF)) - (error/wrap #Exhaustive) + (error;wrap #Exhaustive) [(#Variant allA casesA) (#Variant allSF casesSF)] (let [addition-cases (cases allSF) @@ -282,7 +282,7 @@ ## The 2 sequences cannot possibly be merged. [#0 #0] - (error/wrap (#Alt so-far addition)) + (error;wrap (#Alt so-far addition)) ## There is nothing the addition adds to the coverage. [#1 #1] @@ -294,7 +294,7 @@ ## The addition completes the coverage. [#Exhaustive _] - (error/wrap #Exhaustive) + (error;wrap #Exhaustive) ## The left part will always match, so the addition is redundant. (^multi [(#Seq left right) single] @@ -304,7 +304,7 @@ ## The right part is not necessary, since it can always match the left. (^multi [single (#Seq left right)] (coverage/= left single)) - (error/wrap single) + (error;wrap single) ## When merging a new coverage against one based on Alt, it may be ## that one of the many coverages in the Alt is complementary to @@ -353,7 +353,7 @@ #.None (case (list.reverse possibilitiesSF) (#.Cons last prevs) - (wrap (list/fold (function (_ left right) (#Alt left right)) + (wrap (list;fold (function (_ left right) (#Alt left right)) last prevs)) @@ -365,4 +365,4 @@ ## The addition cannot possibly improve the coverage. (ex.throw redundant-pattern [so-far addition]) ## There are now 2 alternative paths. - (error/wrap (#Alt so-far addition))))) + (error;wrap (#Alt so-far addition))))) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/function.lux b/stdlib/source/lux/tool/compiler/phase/analysis/function.lux index 0438ee4c8..690ee2658 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/function.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/function.lux @@ -8,7 +8,7 @@ ["." text format] [collection - ["." list ("#/." fold monoid monad)]]] + ["." list ("#;." fold monoid monad)]]] ["." type ["." check]] ["." macro]] @@ -31,7 +31,7 @@ (ex.report ["Function" (%type function)] ["Arguments" (|> arguments list.enumerate - (list/map (.function (_ [idx argC]) + (list;map (.function (_ [idx argC]) (format text.new-line " " (%n idx) " " (%code argC)))) (text.join-with ""))])) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/inference.lux b/stdlib/source/lux/tool/compiler/phase/analysis/inference.lux index 3b40b09d2..d677d4222 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/inference.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/inference.lux @@ -8,13 +8,13 @@ ["." text format] [collection - ["." list ("#/." functor)]]] + ["." list ("#;." functor)]]] ["." type ["." check]] ["." macro]] ["." // #_ ["#." type] - ["#/" // ("#/." monad) + ["#/" // ("#;." monad) ["#." extension] [// ["/" analysis (#+ Tag Analysis Operation Phase)]]]]) @@ -28,7 +28,7 @@ (ex.report ["Type" (%type type)] ["Arguments" (|> args list.enumerate - (list/map (function (_ [idx argC]) + (list;map (function (_ [idx argC]) (format text.new-line " " (%n idx) " " (%code argC)))) (text.join-with ""))])) @@ -53,7 +53,7 @@ (-> Nat Type Type Type) (case type (#.Primitive name params) - (#.Primitive name (list/map (replace parameter-idx replacement) params)) + (#.Primitive name (list;map (replace parameter-idx replacement) params)) (^template [<tag>] (<tag> left right) @@ -71,7 +71,7 @@ (^template [<tag>] (<tag> env quantified) - (<tag> (list/map (replace parameter-idx replacement) env) + (<tag> (list;map (replace parameter-idx replacement) env) (replace (n/+ 2 parameter-idx) replacement quantified))) ([#.UnivQ] [#.ExQ]) @@ -193,7 +193,7 @@ (///.throw invalid-type-application inferT)) (#.Product _) - (////wrap (type.function (type.flatten-tuple inferT) inferT)) + (///;wrap (type.function (type.flatten-tuple inferT) inferT)) _ (///.throw not-a-record-type inferT))) @@ -226,7 +226,7 @@ (n/< boundary tag))) (case (list.nth tag cases) (#.Some caseT) - (////wrap (if (n/= 0 depth) + (///;wrap (if (n/= 0 depth) (type.function (list caseT) currentT) (let [replace' (replace (|> depth dec (n/* 2)) inferT)] (type.function (list (replace' caseT)) @@ -240,7 +240,7 @@ (n/= boundary tag) (let [caseT (type.variant (list.drop boundary cases))] - (////wrap (if (n/= 0 depth) + (///;wrap (if (n/= 0 depth) (type.function (list caseT) currentT) (let [replace' (replace (|> depth dec (n/* 2)) inferT)] (type.function (list (replace' caseT)) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/module.lux b/stdlib/source/lux/tool/compiler/phase/analysis/module.lux index b2af57b50..cc7c857a0 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/module.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/module.lux @@ -5,11 +5,11 @@ ["ex" exception (#+ exception:)] pipe] [data - ["." text ("#/." equivalence) + ["." text ("#;." equivalence) format] ["." error] [collection - ["." list ("#/." fold functor)] + ["." list ("#;." fold functor)] [dictionary ["." plist]]]] ["." macro]] @@ -236,16 +236,16 @@ (///.throw cannot-declare-tags-for-unnamed-type [tags type])) _ (ensure-undeclared-tags self-name tags) _ (///.assert cannot-declare-tags-for-foreign-type [tags type] - (text/= self-name type-module))] + (text;= self-name type-module))] (///extension.lift (function (_ state) (case (|> state (get@ #.modules) (plist.get self-name)) (#.Some module) - (let [namespaced-tags (list/map (|>> [self-name]) tags)] + (let [namespaced-tags (list;map (|>> [self-name]) tags)] (#error.Success [(update@ #.modules (plist.update self-name (|>> (update@ #.tags (function (_ tag-bindings) - (list/fold (function (_ [idx tag] table) + (list;fold (function (_ [idx tag] table) (plist.put tag [idx namespaced-tags exported? type] table)) tag-bindings (list.enumerate tags)))) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux b/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux index dad708219..dd5fd08e6 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux @@ -5,7 +5,7 @@ ["ex" exception (#+ exception:)]] ["." macro] [data - ["." text ("#/." equivalence) + ["." text ("#;." equivalence) format]]] ["." // #_ ["#." scope] @@ -37,7 +37,7 @@ [_ (//type.infer actualT) (^@ def-name [::module ::name]) (///extension.lift (macro.normalize def-name)) current (///extension.lift macro.current-module-name)] - (if (text/= current ::module) + (if (text;= current ::module) <return> (if (macro.export? def-anns) (do @ diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/scope.lux b/stdlib/source/lux/tool/compiler/phase/analysis/scope.lux index 9ad60ebf9..9033344b3 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/scope.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/scope.lux @@ -4,13 +4,13 @@ monad ["ex" exception (#+ exception:)]] [data - ["." text ("#/." equivalence) + ["." text ("#;." equivalence) format] - ["." maybe ("#/." monad)] + ["." maybe ("#;." monad)] ["." product] ["e" error] [collection - ["." list ("#/." functor fold monoid)] + ["." list ("#;." functor fold monoid)] [dictionary ["." plist]]]]] ["." /// @@ -33,7 +33,7 @@ (|> scope (get@ [#.locals #.mappings]) (plist.get name) - (maybe/map (function (_ [type value]) + (maybe;map (function (_ [type value]) [type (#////reference.Local value)])))) (def: (captured? name scope) @@ -48,7 +48,7 @@ mappings (get@ [#.captured #.mappings] scope)] (case mappings (#.Cons [_name [_source-type _source-ref]] mappings') - (if (text/= name _name) + (if (text;= name _name) (#.Some [_source-type (#////reference.Foreign idx)]) (recur (inc idx) mappings')) @@ -83,7 +83,7 @@ (#.Cons top-outer _) (let [[ref-type init-ref] (maybe.default (undefined) (..reference name top-outer)) - [ref inner'] (list/fold (: (-> Scope [Variable (List Scope)] [Variable (List Scope)]) + [ref inner'] (list;fold (: (-> Scope [Variable (List Scope)] [Variable (List Scope)]) (function (_ scope ref+inner) [(#////reference.Foreign (get@ [#.captured #.counter] scope)) (#.Cons (update@ #.captured @@ -94,7 +94,7 @@ (product.right ref+inner))])) [init-ref #.Nil] (list.reverse inner)) - scopes (list/compose inner' outer)] + scopes (list;compose inner' outer)] (#.Right [(set@ #.scopes scopes state) (#.Some [ref-type ref])])) ))))) @@ -203,4 +203,4 @@ (-> Scope (List Variable)) (|> scope (get@ [#.captured #.mappings]) - (list/map (function (_ [_ [_ ref]]) (ref-to-variable ref))))) + (list;map (function (_ [_ [_ ref]]) (ref-to-variable ref))))) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux b/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux index 0a6017cdc..9d78121d5 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux @@ -14,7 +14,7 @@ [text format] [collection - ["." list ("#/." functor)] + ["." list ("#;." functor)] ["." dictionary (#+ Dictionary)]]] ["." type ["." check]] @@ -63,7 +63,7 @@ (do-template [<name>] [(exception: #export (<name> {key Name} {record (List [Name Code])}) (ex.report ["Tag" (%code (code.tag key))] - ["Record" (%code (code.record (list/map (function (_ [keyI valC]) + ["Record" (%code (code.record (list;map (function (_ [keyI valC]) [(code.tag keyI) valC]) record)))]))] @@ -79,7 +79,7 @@ ["Actual" (|> actual .int %i)] ["Type" (%type type)] ["Expression" (%code (|> record - (list/map (function (_ [keyI valueC]) + (list;map (function (_ [keyI valueC]) [(code.tag keyI) valueC])) code.record))])) @@ -217,8 +217,8 @@ membersC) _ (//type.with-env (check.check expectedT - (type.tuple (list/map product.left membersTA))))] - (wrap (/.tuple (list/map product.right membersTA)))))) + (type.tuple (list;map product.left membersTA))))] + (wrap (/.tuple (list;map product.right membersTA)))))) (^template [<tag> <instancer>] (<tag> _) @@ -330,7 +330,7 @@ (: (Dictionary Nat Code) (dictionary.new nat.hash)) record) - #let [ordered-tuple (list/map (function (_ idx) (maybe.assume (dictionary.get idx idx->val))) + #let [ordered-tuple (list;map (function (_ idx) (maybe.assume (dictionary.get idx idx->val))) tuple-range)]] (wrap [ordered-tuple recordT])) )) diff --git a/stdlib/source/lux/tool/compiler/phase/extension.lux b/stdlib/source/lux/tool/compiler/phase/extension.lux index 86b2e6b38..653d3e011 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension.lux @@ -5,10 +5,10 @@ ["ex" exception (#+ exception:)]] [data ["." error (#+ Error)] - ["." text ("#/." order) + ["." text ("#;." order) format] [collection - ["." list ("#/." functor)] + ["." list ("#;." functor)] ["." dictionary (#+ Dictionary)]]] ["." function]] ["." //]) @@ -49,8 +49,8 @@ (ex.report ["Extension" (%t name)] ["Available" (|> bundle dictionary.keys - (list.sort text/<) - (list/map (|>> %t (format text.new-line text.tab))) + (list.sort text;<) + (list;map (|>> %t (format text.new-line text.tab))) (text.join-with ""))])) (exception: #export (incorrect-arity {name Name} {arity Nat} {args Nat}) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux index dbe0b10ca..bff1d8527 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux @@ -6,7 +6,7 @@ ["." text format] [collection - ["." list ("#/." functor)] + ["." list ("#;." functor)] ["." dictionary (#+ Dictionary)]]] [type ["." check]] diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.jvm.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.jvm.lux index 6b1e6ed5b..428bffd66 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.jvm.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.jvm.lux @@ -9,10 +9,10 @@ ["." error (#+ Error)] ["." maybe] ["." product] - ["." text ("#/." equivalence) + ["." text ("#;." equivalence) format] [collection - ["." list ("#/." fold functor monoid)] + ["." list ("#;." fold functor monoid)] ["." array (#+ Array)] ["." dictionary (#+ Dictionary)]]] ["." type @@ -24,7 +24,7 @@ ["#." common] ["#/" // ["#." bundle] - ["#/" // ("#/." monad) + ["#/" // ("#;." monad) [analysis [".A" type] [".A" inference]] @@ -96,7 +96,7 @@ (ex.report ["Class" class] ["Method" method] ["Hints" (|> hints - (list/map (|>> product.left %type (format text.new-line text.tab))) + (list;map (|>> product.left %type (format text.new-line text.tab))) (text.join-with ""))]))] [no-candidates] @@ -277,13 +277,13 @@ (-> Type (Operation Text)) (case objectT (#.Primitive name _) - (/////wrap name) + (////;wrap name) (#.Named name unnamed) (check-jvm unnamed) (#.Var id) - (/////wrap "java.lang.Object") + (////;wrap "java.lang.Object") (^template [<tag>] (<tag> env unquantified) @@ -308,7 +308,7 @@ [name (check-jvm objectT)] (if (dictionary.contains? name boxes) (////.throw primitives-are-not-objects name) - (/////wrap name)))) + (////;wrap name)))) (def: (box-array-element-type elemT) (-> Type (Operation [Type Text])) @@ -316,13 +316,13 @@ (#.Primitive name #.Nil) (let [boxed-name (|> (dictionary.get name boxes) (maybe.default name))] - (/////wrap [(#.Primitive boxed-name #.Nil) + (////;wrap [(#.Primitive boxed-name #.Nil) boxed-name])) (#.Primitive name _) (if (dictionary.contains? name boxes) (////.throw primitives-cannot-have-type-parameters name) - (/////wrap [elemT name])) + (////;wrap [elemT name])) _ (////.throw invalid-type-for-array-element (%type elemT)))) @@ -564,7 +564,7 @@ (-> java/lang/reflect/Type (Operation Text)) (<| (case (host.check Class jvm-type) (#.Some jvm-type) - (/////wrap (Class::getName jvm-type)) + (////;wrap (Class::getName jvm-type)) _) (case (host.check ParameterizedType jvm-type) @@ -587,7 +587,7 @@ (let [var-name (TypeVariable::getName java-type)] (case (dictionary.get var-name mappings) (#.Some var-type) - (/////wrap var-type) + (////;wrap var-type) #.None (////.throw unknown-type-var var-name))) @@ -601,21 +601,21 @@ (java-type-to-lux-type mappings bound) _ - (/////wrap Any)) + (////;wrap Any)) _) (case (host.check Class java-type) (#.Some java-type) (let [java-type (:coerce (Class Object) java-type) class-name (Class::getName java-type)] - (/////wrap (case (array.size (Class::getTypeParameters java-type)) + (////;wrap (case (array.size (Class::getTypeParameters java-type)) 0 (#.Primitive class-name (list)) arity (|> (list.indices arity) list.reverse - (list/map (|>> (n/* 2) inc #.Parameter)) + (list;map (|>> (n/* 2) inc #.Parameter)) (#.Primitive class-name) (type.univ-q arity))))) @@ -630,7 +630,7 @@ ParameterizedType::getActualTypeArguments array.to-list (monad.map @ (java-type-to-lux-type mappings)))] - (/////wrap (#.Primitive (Class::getName (:coerce (Class Object) raw)) + (////;wrap (#.Primitive (Class::getName (:coerce (Class Object) raw)) paramsT))) _ @@ -657,7 +657,7 @@ class-params (array.to-list (Class::getTypeParameters class)) num-class-params (list.size class-params) num-type-params (list.size params)] - (cond (not (text/= class-name name)) + (cond (not (text;= class-name name)) (////.throw cannot-correspond-type-with-a-class (format "Class = " class-name text.new-line "Type = " (%type type))) @@ -670,8 +670,8 @@ " Type: " (%type type))) ## else - (/////wrap (|> params - (list.zip2 (list/map (|>> TypeVariable::getName) class-params)) + (////;wrap (|> params + (list.zip2 (list;map (|>> TypeVariable::getName) class-params)) (dictionary.from-list text.hash))) )) @@ -714,7 +714,7 @@ (not (dictionary.contains? to-name boxes))) to-class (load-class to-name)] (loop [[current-name currentT] [from-name valueT]] - (if (text/= to-name current-name) + (if (text;= to-name current-name) (do @ [_ (typeA.infer toT)] (wrap #1)) @@ -734,7 +734,7 @@ (array.to-list (Class::getGenericInterfaces current-class))))] (case (|> candiate-parents (list.filter product.right) - (list/map product.left)) + (list;map product.left)) (#.Cons [next-name nextJT] _) (do @ [mapping (correspond-type-params current-class currentT) @@ -810,7 +810,7 @@ var-names (|> class Class::getTypeParameters array.to-list - (list/map (|>> TypeVariable::getName)))] + (list;map (|>> TypeVariable::getName)))] mappings (: (Operation Mappings) (case objectT (#.Primitive _class-name _class-params) @@ -918,7 +918,7 @@ (-> java/lang/reflect/Type (Operation Text)) (<| (case (host.check Class type) (#.Some type) - (/////wrap (Class::getName type)) + (////;wrap (Class::getName type)) _) (case (host.check ParameterizedType type) @@ -928,12 +928,12 @@ _) (case (host.check TypeVariable type) (#.Some type) - (/////wrap "java.lang.Object") + (////;wrap "java.lang.Object") _) (case (host.check WildcardType type) (#.Some type) - (/////wrap "java.lang.Object") + (////;wrap "java.lang.Object") _) (case (host.check GenericArrayType type) @@ -962,7 +962,7 @@ (monad.map @ java-type-to-parameter)) #let [modifiers (Method::getModifiers method)]] (wrap (and (Object::equals class (Method::getDeclaringClass method)) - (text/= method-name (Method::getName method)) + (text;= method-name (Method::getName method)) (case #Static #Special (Modifier::isStatic modifiers) @@ -977,9 +977,9 @@ _ #1) (n/= (list.size arg-classes) (list.size parameters)) - (list/fold (function (_ [expectedJC actualJC] prev) + (list;fold (function (_ [expectedJC actualJC] prev) (and prev - (text/= expectedJC actualJC))) + (text;= expectedJC actualJC))) #1 (list.zip2 arg-classes parameters)))))) @@ -991,9 +991,9 @@ (monad.map @ java-type-to-parameter))] (wrap (and (Object::equals class (Constructor::getDeclaringClass constructor)) (n/= (list.size arg-classes) (list.size parameters)) - (list/fold (function (_ [expectedJC actualJC] prev) + (list;fold (function (_ [expectedJC actualJC] prev) (and prev - (text/= expectedJC actualJC))) + (text;= expectedJC actualJC))) #1 (list.zip2 arg-classes parameters)))))) @@ -1006,7 +1006,7 @@ (if (n/= 0 amount) (list) (|> (list.indices amount) - (list/map (|>> (n/+ offset) idx-to-parameter))))) + (list;map (|>> (n/+ offset) idx-to-parameter))))) (def: (method-signature method-style method) (-> Method-Style Method (Operation Method-Signature)) @@ -1019,20 +1019,20 @@ _ (|> (Class::getTypeParameters owner) array.to-list - (list/map (|>> TypeVariable::getName)))) + (list;map (|>> TypeVariable::getName)))) method-tvars (|> (Method::getTypeParameters method) array.to-list - (list/map (|>> TypeVariable::getName))) + (list;map (|>> TypeVariable::getName))) num-owner-tvars (list.size owner-tvars) num-method-tvars (list.size method-tvars) - all-tvars (list/compose owner-tvars method-tvars) + all-tvars (list;compose owner-tvars method-tvars) num-all-tvars (list.size all-tvars) owner-tvarsT (type-vars num-owner-tvars 0) method-tvarsT (type-vars num-method-tvars num-owner-tvars) mappings (: Mappings (if (list.empty? all-tvars) fresh-mappings - (|> (list/compose owner-tvarsT method-tvarsT) + (|> (list;compose owner-tvarsT method-tvarsT) list.reverse (list.zip2 all-tvars) (dictionary.from-list text.hash))))] @@ -1087,7 +1087,7 @@ (cond passes? (:: @ map (|>> #Pass) (method-signature method-style method)) - (text/= method-name (Method::getName method)) + (text;= method-name (Method::getName method)) (:: @ map (|>> #Hint) (method-signature method-style method)) ## else @@ -1108,19 +1108,19 @@ owner-name (Class::getName owner) owner-tvars (|> (Class::getTypeParameters owner) array.to-list - (list/map (|>> TypeVariable::getName))) + (list;map (|>> TypeVariable::getName))) constructor-tvars (|> (Constructor::getTypeParameters constructor) array.to-list - (list/map (|>> TypeVariable::getName))) + (list;map (|>> TypeVariable::getName))) num-owner-tvars (list.size owner-tvars) - all-tvars (list/compose owner-tvars constructor-tvars) + all-tvars (list;compose owner-tvars constructor-tvars) num-all-tvars (list.size all-tvars) owner-tvarsT (type-vars num-owner-tvars 0) constructor-tvarsT (type-vars num-all-tvars num-owner-tvars) mappings (: Mappings (if (list.empty? all-tvars) fresh-mappings - (|> (list/compose owner-tvarsT constructor-tvarsT) + (|> (list;compose owner-tvarsT constructor-tvarsT) list.reverse (list.zip2 all-tvars) (dictionary.from-list text.hash))))] @@ -1165,8 +1165,8 @@ (def: (decorate-inputs typesT inputsA) (-> (List Text) (List Analysis) (List Analysis)) (|> inputsA - (list.zip2 (list/map /////analysis.text typesT)) - (list/map (function (_ [type value]) + (list.zip2 (list;map /////analysis.text typesT)) + (list;map (function (_ [type value]) (/////analysis.tuple (list type value)))))) (def: invoke::static @@ -1176,9 +1176,9 @@ (s.run args ($_ p.and s.text s.text (p.some (s.tuple (p.and s.text s.any)))))) (#error.Success [class method argsTC]) (do ////.monad - [#let [argsT (list/map product.left argsTC)] + [#let [argsT (list;map product.left argsTC)] [methodT exceptionsT] (method-candidate class method #Static argsT) - [outputT argsA] (inferenceA.general analyse methodT (list/map product.right argsTC)) + [outputT argsA] (inferenceA.general analyse methodT (list;map product.right argsTC)) outputJC (check-jvm outputT)] (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class) (/////analysis.text method) (/////analysis.text outputJC) (decorate-inputs argsT argsA))))) @@ -1193,9 +1193,9 @@ (s.run args ($_ p.and s.text s.text s.any (p.some (s.tuple (p.and s.text s.any)))))) (#error.Success [class method objectC argsTC]) (do ////.monad - [#let [argsT (list/map product.left argsTC)] + [#let [argsT (list;map product.left argsTC)] [methodT exceptionsT] (method-candidate class method #Virtual argsT) - [outputT allA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC))) + [outputT allA] (inferenceA.general analyse methodT (list& objectC (list;map product.right argsTC))) #let [[objectA argsA] (case allA (#.Cons objectA argsA) [objectA argsA] @@ -1216,9 +1216,9 @@ (p.run args ($_ p.and s.text s.text s.any (p.some (s.tuple (p.and s.text s.any))) s.end!))) (#error.Success [_ [class method objectC argsTC _]]) (do ////.monad - [#let [argsT (list/map product.left argsTC)] + [#let [argsT (list;map product.left argsTC)] [methodT exceptionsT] (method-candidate class method #Special argsT) - [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC))) + [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list;map product.right argsTC))) outputJC (check-jvm outputT)] (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class) (/////analysis.text method) (/////analysis.text outputJC) (decorate-inputs argsT argsA))))) @@ -1233,12 +1233,12 @@ (s.run args ($_ p.and s.text s.text s.any (p.some (s.tuple (p.and s.text s.any)))))) (#error.Success [class-name method objectC argsTC]) (do ////.monad - [#let [argsT (list/map product.left argsTC)] + [#let [argsT (list;map product.left argsTC)] class (load-class class-name) _ (////.assert non-interface class-name (Modifier::isInterface (Class::getModifiers class))) [methodT exceptionsT] (method-candidate class-name method #Interface argsT) - [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC))) + [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list;map product.right argsTC))) outputJC (check-jvm outputT)] (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class-name) (/////analysis.text method) (/////analysis.text outputJC) @@ -1254,9 +1254,9 @@ (s.run args ($_ p.and s.text (p.some (s.tuple (p.and s.text s.any)))))) (#error.Success [class argsTC]) (do ////.monad - [#let [argsT (list/map product.left argsTC)] + [#let [argsT (list;map product.left argsTC)] [methodT exceptionsT] (constructor-candidate class argsT) - [outputT argsA] (inferenceA.general analyse methodT (list/map product.right argsTC))] + [outputT argsA] (inferenceA.general analyse methodT (list;map product.right argsTC))] (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class) (decorate-inputs argsT argsA))))) _ diff --git a/stdlib/source/lux/tool/compiler/phase/extension/bundle.lux b/stdlib/source/lux/tool/compiler/phase/extension/bundle.lux index 643e3b38c..ad99db848 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/bundle.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/bundle.lux @@ -6,7 +6,7 @@ ["." text format] [collection - ["." list ("#/." functor)] + ["." list ("#;." functor)] ["." dictionary (#+ Dictionary)]]]] [// (#+ Handler Bundle)]) @@ -24,5 +24,5 @@ (All [s i o] (-> Text (-> (Bundle s i o) (Bundle s i o)))) (|>> dictionary.entries - (list/map (function (_ [key val]) [(format prefix " " key) val])) + (list;map (function (_ [key val]) [(format prefix " " key) val])) (dictionary.from-list text.hash))) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux index 5c957aab1..172517dd0 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux @@ -7,7 +7,7 @@ [text format] [collection - ["." list ("#/." functor)] + ["." list ("#;." functor)] ["." dictionary]]] ["." macro] [type (#+ :share :by-example) diff --git a/stdlib/source/lux/tool/compiler/phase/generation.lux b/stdlib/source/lux/tool/compiler/phase/generation.lux index 99a4c5517..3fe3f867b 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation.lux @@ -6,7 +6,7 @@ [data ["." product] ["." error (#+ Error)] - ["." name ("#/." equivalence)] + ["." name ("#;." equivalence)] ["." text format] [collection @@ -212,7 +212,7 @@ ?buffer (extension.read (get@ #buffer))] (case ?buffer (#.Some buffer) - (if (row.any? (|>> product.left (name/= name)) buffer) + (if (row.any? (|>> product.left (name;= name)) buffer) (//.throw cannot-overwrite-output name) (extension.update (set@ #buffer (#.Some (row.add [name code] buffer))))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js.lux b/stdlib/source/lux/tool/compiler/phase/generation/js.lux index df0db4c79..5da2a016e 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js.lux @@ -6,7 +6,7 @@ [runtime (#+ Phase)] ["." primitive] ["." structure] - ["." reference ("#/." system)] + ["." reference ("#;." system)] ["." function] ["." case] ["." loop] @@ -33,7 +33,7 @@ (structure.tuple generate members) (#synthesis.Reference value) - (reference/reference value) + (reference;reference value) (^ (synthesis.branch/case case)) (case.case generate case) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux index 8dba99feb..ed2c74a4b 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux @@ -8,7 +8,7 @@ ["." text format] [collection - ["." list ("#/." functor fold)]]] + ["." list ("#;." functor fold)]]] [host ["_" js (#+ Expression Computation Var Statement)]]] ["." // #_ @@ -17,7 +17,7 @@ ["#." primitive] ["#/" // #_ ["#." reference] - ["#/" // ("#/." monad) + ["#/" // ("#;." monad) ["#/" // #_ [reference (#+ Register)] ["#." synthesis (#+ Synthesis Path)]]]]]) @@ -43,7 +43,7 @@ (Operation Expression)) (do ////.monad [valueO (generate valueS)] - (wrap (list/fold (function (_ [idx tail?] source) + (wrap (list;fold (function (_ [idx tail?] source) (.let [method (.if tail? //runtime.product//right //runtime.product//left)] @@ -127,14 +127,14 @@ (wrap (_.return body!))) #/////synthesis.Pop - (/////wrap pop-cursor!) + (////;wrap pop-cursor!) (#/////synthesis.Bind register) - (/////wrap (_.define (..register register) ..peek-cursor)) + (////;wrap (_.define (..register register) ..peek-cursor)) (^template [<tag> <format> <=>] (^ (<tag> value)) - (/////wrap (_.when (|> value <format> (<=> ..peek-cursor) _.not) + (////;wrap (_.when (|> value <format> (<=> ..peek-cursor) _.not) fail-pm!))) ([/////synthesis.path/bit //primitive.bit _.=] [/////synthesis.path/i64 (<| //primitive.i64 .int) //runtime.i64//=] @@ -143,7 +143,7 @@ (^template [<pm> <flag> <prep>] (^ (<pm> idx)) - (/////wrap ($_ _.then + (////;wrap ($_ _.then (_.set @temp (|> idx <prep> .int _.i32 (//runtime.sum//get ..peek-cursor <flag>))) (_.if (_.= _.null @temp) fail-pm! @@ -153,7 +153,7 @@ (^template [<pm> <getter> <prep>] (^ (<pm> idx)) - (/////wrap (|> idx <prep> .int _.i32 (<getter> ..peek-cursor) push-cursor!))) + (////;wrap (|> idx <prep> .int _.i32 (<getter> ..peek-cursor) push-cursor!))) ([/////synthesis.member/left //runtime.product//left (<|)] [/////synthesis.member/right //runtime.product//right inc]) @@ -163,7 +163,7 @@ thenP)) (do ////.monad [then! (pattern-matching' generate thenP)] - (/////wrap ($_ _.then + (////;wrap ($_ _.then (_.define (..register register) ..peek-and-pop-cursor) then!))) @@ -174,7 +174,7 @@ (.let [[extra-pops nextP'] (count-pops nextP)] (do ////.monad [next! (pattern-matching' generate nextP')] - (/////wrap ($_ _.then + (////;wrap ($_ _.then (multi-pop-cursor! (n/+ 2 extra-pops)) next!)))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux index cbac2ca3f..dfd0e4aee 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux @@ -8,7 +8,7 @@ ["." product] [number (#+ hex)] [collection - ["." list ("#/." functor)] + ["." list ("#;." functor)] ["." dictionary]]] ["." macro (#+ with-gensyms) ["." code] @@ -45,7 +45,7 @@ (^ (list (~+ g!input+))) (do /////.monad [(~+ (|> g!input+ - (list/map (function (_ g!input) + (list;map (function (_ g!input) (list g!input (` ((~ g!phase) (~ g!input)))))) list.concat))] ((~' wrap) ((~ g!extension) [(~+ g!input+)]))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/function.lux index 1d74112e2..a99546957 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/function.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/function.lux @@ -8,7 +8,7 @@ [text format] [collection - ["." list ("#/." functor fold)]]] + ["." list ("#;." functor fold)]]] [host ["_" js (#+ Expression Computation Var)]]] ["." // #_ @@ -17,7 +17,7 @@ ["#." case] ["#/" // ["#." reference] - ["#/" // ("#/." monad) + ["#/" // ("#;." monad) ["." // #_ [reference (#+ Register Variable)] [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)] @@ -35,14 +35,14 @@ (def: (with-closure inits function-definition) (-> (List Expression) Computation (Operation Computation)) - (/////wrap + (////;wrap (case inits #.Nil function-definition _ (let [closure (_.closure (|> (list.enumerate inits) - (list/map (|>> product.left ..capture))) + (list;map (|>> product.left ..capture))) (_.return function-definition))] (_.apply/* closure inits))))) @@ -69,7 +69,7 @@ apply-poly (.function (_ args func) (|> func (_.do "apply" (list _.null args)))) initialize-self! (_.define (//case.register 0) @self) - initialize! (list/fold (.function (_ post pre!) + initialize! (list;fold (.function (_ post pre!) ($_ _.then pre! (_.define (..input post) (_.at (_.i32 (.int post)) @@arguments)))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/loop.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/loop.lux index ba12e4c03..e0ec074d3 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/loop.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/loop.lux @@ -7,7 +7,7 @@ ["." text format] [collection - ["." list ("#/." functor)]]] + ["." list ("#;." functor)]]] [host ["_" js (#+ Computation Var)]]] ["." // #_ @@ -29,7 +29,7 @@ #let [closure (_.function @scope (|> initsS+ list.enumerate - (list/map (|>> product.left (n/+ start) //case.register))) + (list;map (|>> product.left (n/+ start) //case.register))) (_.return bodyO))]] (wrap (_.apply/* closure initsO+)))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux index fe400e403..b3ff414b2 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux @@ -10,7 +10,7 @@ ["." text format] [collection - ["." list ("#/." functor)]]] + ["." list ("#;." functor)]]] ["." macro ["." code] ["s" syntax (#+ syntax:)]] @@ -102,7 +102,7 @@ (syntax: #export (with-vars {vars (s.tuple (p.some s.local-identifier))} body) (wrap (list (` (let [(~+ (|> vars - (list/map (function (_ var) + (list;map (function (_ var) (list (code.local-identifier var) (` (_.var (~ (code.text (/////name.normalize var)))))))) list.concat))] @@ -130,8 +130,8 @@ (let [nameC (code.local-identifier name) code-nameC (code.local-identifier (format "@" name)) runtime-nameC (` (runtime-name (~ (code.text name)))) - inputsC (list/map code.local-identifier inputs) - inputs-typesC (list/map (function.constant (` _.Expression)) inputs)] + 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))))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/reference.lux b/stdlib/source/lux/tool/compiler/phase/generation/reference.lux index f8c875ccc..4907ada5d 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/reference.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/reference.lux @@ -7,7 +7,7 @@ format]] [type (#+ :share)]] ["." // - ["#/" // ("#/." monad) + ["#/" // ("#;." monad) ["#/" // #_ [synthesis (#+ Synthesis)] ["#." reference (#+ Register Variable Reference)]]]]) @@ -61,13 +61,13 @@ (#////reference.Foreign register) (foreign register)) - ////wrap)}) + ///;wrap)}) constant (:share [expression] {(-> Text expression) constant} {(All [anchor statement] (-> Name (//.Operation anchor expression statement))) - (|>> //.remember (////map constant))})] + (|>> //.remember (///;map constant))})] (structure (def: local local) (def: foreign foreign) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme.lux index df0db4c79..5da2a016e 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/scheme.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme.lux @@ -6,7 +6,7 @@ [runtime (#+ Phase)] ["." primitive] ["." structure] - ["." reference ("#/." system)] + ["." reference ("#;." system)] ["." function] ["." case] ["." loop] @@ -33,7 +33,7 @@ (structure.tuple generate members) (#synthesis.Reference value) - (reference/reference value) + (reference;reference value) (^ (synthesis.branch/case case)) (case.case generate case) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/case.jvm.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/case.jvm.lux index 142e4a165..49733e6f3 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/case.jvm.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/case.jvm.lux @@ -8,7 +8,7 @@ ["." text format] [collection - ["." list ("#/." functor fold)]]] + ["." list ("#;." functor fold)]]] [host ["_" scheme (#+ Expression Computation Var)]]] ["." // #_ @@ -16,7 +16,7 @@ ["#." primitive] ["#/" // #_ ["#." reference] - ["#/" // ("#/." monad) + ["#/" // ("#;." monad) ["#/" // #_ [reference (#+ Register)] ["#." synthesis (#+ Synthesis Path)]]]]]) @@ -38,7 +38,7 @@ (Operation Expression)) (do ////.monad [valueO (generate valueS)] - (wrap (list/fold (function (_ [idx tail?] source) + (wrap (list;fold (function (_ [idx tail?] source) (.let [method (.if tail? //runtime.product//right //runtime.product//left)] @@ -108,15 +108,15 @@ (generate bodyS) #/////synthesis.Pop - (/////wrap pop-cursor!) + (////;wrap pop-cursor!) (#/////synthesis.Bind register) - (/////wrap (_.define (..register register) [(list) #.None] + (////;wrap (_.define (..register register) [(list) #.None] cursor-top)) (^template [<tag> <format> <=>] (^ (<tag> value)) - (/////wrap (_.when (|> value <format> (<=> cursor-top) _.not/1) + (////;wrap (_.when (|> value <format> (<=> cursor-top) _.not/1) fail-pm!))) ([/////synthesis.path/bit //primitive.bit _.eqv?/2] [/////synthesis.path/i64 (<| //primitive.i64 .int) _.=/2] @@ -125,7 +125,7 @@ (^template [<pm> <flag> <prep>] (^ (<pm> idx)) - (/////wrap (_.let (list [@temp (|> idx <prep> .int _.int (//runtime.sum//get cursor-top <flag>))]) + (////;wrap (_.let (list [@temp (|> idx <prep> .int _.int (//runtime.sum//get cursor-top <flag>))]) (_.if (_.null?/1 @temp) fail-pm! (push-cursor! @temp))))) @@ -134,7 +134,7 @@ (^template [<pm> <getter> <prep>] (^ (<pm> idx)) - (/////wrap (|> idx <prep> .int _.int (<getter> cursor-top) push-cursor!))) + (////;wrap (|> idx <prep> .int _.int (<getter> cursor-top) push-cursor!))) ([/////synthesis.member/left //runtime.product//left (<|)] [/////synthesis.member/right //runtime.product//right inc]) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.jvm.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.jvm.lux index bcb98f893..950a32e1d 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.jvm.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.jvm.lux @@ -10,7 +10,7 @@ format] [number (#+ hex)] [collection - ["." list ("#/." functor)] + ["." list ("#;." functor)] ["dict" dictionary (#+ Dictionary)]]] ["." macro (#+ with-gensyms) ["." code] @@ -46,7 +46,7 @@ (^ (list (~+ g!input+))) (do /////.monad [(~+ (|> g!input+ - (list/map (function (_ g!input) + (list;map (function (_ g!input) (list g!input (` ((~ g!phase) (~ g!input)))))) list.concat))] ((~' wrap) ((~ g!extension) [(~+ g!input+)]))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/function.jvm.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/function.jvm.lux index dea1064e1..2cbb89825 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/function.jvm.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/function.jvm.lux @@ -8,7 +8,7 @@ [text format] [collection - ["." list ("#/." functor)]]] + ["." list ("#;." functor)]]] [host ["_" scheme (#+ Expression Computation Var)]]] ["." // #_ @@ -17,7 +17,7 @@ ["#." case] ["#/" // ["#." reference] - ["#/" // ("#/." monad) + ["#/" // ("#;." monad) ["#/" // #_ [reference (#+ Register Variable)] [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)] @@ -35,7 +35,7 @@ (def: (with-closure function-name inits function-definition) (-> Text (List Expression) Computation (Operation Computation)) - (/////wrap + (////;wrap (case inits #.Nil function-definition @@ -44,7 +44,7 @@ (let [@closure (_.var (format function-name "___CLOSURE"))] (_.letrec (list [@closure (_.lambda [(|> (list.enumerate inits) - (list/map (|>> product.left ..capture))) + (list;map (|>> product.left ..capture))) #.None] function-definition)]) (_.apply/* @closure inits)))))) @@ -76,7 +76,7 @@ (<| (_.if (|> @num-args (_.=/2 arityO)) (<| (_.let (list [(//case.register 0) @function])) (_.let-values (list [[(|> (list.indices arity) - (list/map ..input)) + (list;map ..input)) #.None] (_.apply/2 (_.global "apply") (_.global "values") @curried)])) bodyO)) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/loop.jvm.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/loop.jvm.lux index e5038dc58..7064c8301 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/loop.jvm.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/loop.jvm.lux @@ -7,7 +7,7 @@ ["." text format] [collection - ["." list ("#/." functor)]]] + ["." list ("#;." functor)]]] [host ["_" scheme (#+ Computation Var)]]] ["." // #_ @@ -28,7 +28,7 @@ (generate bodyS))] (wrap (_.letrec (list [@scope (_.lambda [(|> initsS+ list.enumerate - (list/map (|>> product.left (n/+ start) //case.register))) + (list;map (|>> product.left (n/+ start) //case.register))) #.None] bodyO)]) (_.apply/* @scope initsO+))))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.jvm.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.jvm.lux index a3490be46..62245a659 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.jvm.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.jvm.lux @@ -2,14 +2,14 @@ [lux #* ["." function] [control - ["p" parser ("#/." monad)] + ["p" parser ("#;." monad)] [monad (#+ do)]] [data [number (#+ hex)] [text format] [collection - ["." list ("#/." monad)]]] + ["." list ("#;." monad)]]] [macro ["." code] ["s" syntax (#+ syntax:)]] @@ -73,7 +73,7 @@ (def: declaration (s.Syntax [Text (List Text)]) - (p.either (p.and s.local-identifier (p/wrap (list))) + (p.either (p.and s.local-identifier (p;wrap (list))) (s.form (p.and s.local-identifier (p.some s.local-identifier))))) (syntax: (runtime: {[name args] declaration} @@ -81,8 +81,8 @@ (let [implementation (code.local-identifier (format "@@" name)) runtime (format prefix "__" (/////name.normalize name)) @runtime (` (_.var (~ (code.text runtime)))) - argsC+ (list/map code.local-identifier args) - argsLC+ (list/map (|>> /////name.normalize (format "LRV__") code.text (~) (_.var) (`)) + argsC+ (list;map code.local-identifier args) + argsLC+ (list;map (|>> /////name.normalize (format "LRV__") code.text (~) (_.var) (`)) args) declaration (` ((~ (code.local-identifier name)) (~+ argsC+))) @@ -104,9 +104,9 @@ _ (` (let [(~+ (|> (list.zip2 argsC+ argsLC+) - (list/map (function (_ [left right]) + (list;map (function (_ [left right]) (list left right))) - list/join))] + list;join))] (_.define (~ @runtime) [(list (~+ argsLC+)) #.None] (~ definition)))))))))))) @@ -127,10 +127,10 @@ (syntax: #export (with-vars {vars (s.tuple (p.many s.local-identifier))} body) (wrap (list (` (let [(~+ (|> vars - (list/map (function (_ var) + (list;map (function (_ var) (list (code.local-identifier var) (` (_.var (~ (code.text (format "LRV__" (/////name.normalize var))))))))) - list/join))] + list;join))] (~ body)))))) (runtime: (lux//try op) diff --git a/stdlib/source/lux/tool/compiler/phase/macro.lux b/stdlib/source/lux/tool/compiler/phase/macro.lux index 0aca19898..a8428a1ac 100644 --- a/stdlib/source/lux/tool/compiler/phase/macro.lux +++ b/stdlib/source/lux/tool/compiler/phase/macro.lux @@ -9,7 +9,7 @@ format] [collection [array (#+ Array)] - ["." list ("#/." functor)]]] + ["." list ("#;." functor)]]] ["." macro] ["." host (#+ import:)]] ["." //]) @@ -18,7 +18,7 @@ (exception.report ["Macro" (%name macro)] ["Inputs" (|> inputs - (list/map (|>> %code (format text.new-line text.tab))) + (list;map (|>> %code (format text.new-line text.tab))) (text.join-with ""))] ["Error" error])) @@ -26,7 +26,7 @@ (exception.report ["Macro" (%name macro)] ["Inputs" (|> inputs - (list/map (|>> %code (format text.new-line text.tab))) + (list;map (|>> %code (format text.new-line text.tab))) (text.join-with ""))])) (import: #long java/lang/reflect/Method diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis.lux b/stdlib/source/lux/tool/compiler/phase/synthesis.lux index c5152ff6a..3da088ccf 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis.lux @@ -7,12 +7,12 @@ ["." maybe] ["." error] [collection - ["." list ("#/." functor)] + ["." list ("#;." functor)] ["." dictionary (#+ Dictionary)]]]] ["." / #_ ["#." function] ["#." case] - ["#/" // ("#/." monad) + ["#/" // ("#;." monad) ["#." extension] ["#/" // #_ ["#." analysis (#+ Analysis)] @@ -42,7 +42,7 @@ Phase (case analysis (#///analysis.Primitive analysis') - (///wrap (#/.Primitive (..primitive analysis'))) + (//;wrap (#/.Primitive (..primitive analysis'))) (#///analysis.Structure structure) (case structure @@ -54,10 +54,10 @@ (#///analysis.Tuple tuple) (|> tuple (monad.map //.monad phase) - (///map (|>> /.tuple)))) + (//;map (|>> /.tuple)))) (#///analysis.Reference reference) - (///wrap (#/.Reference reference)) + (//;wrap (#/.Reference reference)) (#///analysis.Case inputA branchesAB+) (/case.synthesize phase inputA branchesAB+) @@ -85,5 +85,5 @@ (wrap (#/.Extension [name argsS+]))))))) _ - (///wrap (undefined)) + (//;wrap (undefined)) )) diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux index 52d7b09a7..8dd7c342e 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux @@ -6,14 +6,14 @@ ["." monad (#+ do)]] [data ["." product] - ["." bit ("#/." equivalence)] - ["." text ("#/." equivalence) + ["." bit ("#;." equivalence)] + ["." text ("#;." equivalence) format] [number - ["." frac ("#/." equivalence)]] + ["." frac ("#;." equivalence)]] [collection - ["." list ("#/." fold monoid)]]]] - ["." /// ("#/." monad) + ["." list ("#;." fold monoid)]]]] + ["." /// ("#;." monad) ["#/" // ["#." reference] ["#." analysis (#+ Pattern Match Analysis)] @@ -33,7 +33,7 @@ (^template [<from> <to>] (<from> value) - (////map (|>> (#/.Seq (#/.Test (|> value <to>)))) + (///;map (|>> (#/.Seq (#/.Test (|> value <to>)))) thenC)) ([#////analysis.Bit #/.Bit] [#////analysis.Nat (<| #/.I64 .i64)] @@ -48,23 +48,23 @@ thenC) (#////analysis.Complex (#////analysis.Variant [lefts right? value-pattern])) - (<| (////map (|>> (#/.Seq (#/.Access (#/.Side (if right? + (<| (///;map (|>> (#/.Seq (#/.Access (#/.Side (if right? (#.Right lefts) (#.Left lefts))))))) (path' value-pattern end?) - (when> [(new> (not end?) [])] [(////map ..clean-up)]) + (when> [(new> (not end?) [])] [(///;map ..clean-up)]) thenC) (#////analysis.Complex (#////analysis.Tuple tuple)) (let [tuple::last (dec (list.size tuple))] - (list/fold (function (_ [tuple::lefts tuple::member] nextC) + (list;fold (function (_ [tuple::lefts tuple::member] nextC) (let [right? (n/= tuple::last tuple::lefts) end?' (and end? right?)] - (<| (////map (|>> (#/.Seq (#/.Access (#/.Member (if right? + (<| (///;map (|>> (#/.Seq (#/.Access (#/.Member (if right? (#.Right (dec tuple::lefts)) (#.Left tuple::lefts))))))) (path' tuple::member end?') - (when> [(new> (not end?') [])] [(////map ..clean-up)]) + (when> [(new> (not end?') [])] [(///;map ..clean-up)]) nextC))) thenC (list.reverse (list.enumerate tuple)))) @@ -72,7 +72,7 @@ (def: #export (path synthesize pattern bodyA) (-> Phase Pattern Analysis (Operation Path)) - (path' pattern true (////map (|>> #/.Then) (synthesize bodyA)))) + (path' pattern true (///;map (|>> #/.Then) (synthesize bodyA)))) (def: #export (weave leftP rightP) (-> Path Path Path) @@ -96,10 +96,10 @@ (if (<eq> leftV rightV) rightP <default>)) - ([#/.Bit bit/=] + ([#/.Bit bit;=] [#/.I64 "lux i64 ="] - [#/.F64 frac/=] - [#/.Text text/=]) + [#/.F64 frac;=] + [#/.Text text;=]) (^template [<access> <side>] [(#/.Access (<access> (<side> leftL))) @@ -163,7 +163,7 @@ (do @ [lastSP (path synthesize^ lastP lastA) prevsSP+ (monad.map @ (product.uncurry (path synthesize^)) prevsPA)] - (wrap (/.branch/case [inputS (list/fold weave lastSP prevsSP+)])))))] + (wrap (/.branch/case [inputS (list;fold weave lastSP prevsSP+)])))))] (case [headB tailB+] <let> <if> diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux index 547e684c2..a1bc743c3 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux @@ -8,11 +8,11 @@ ["." text format] [collection - ["." list ("#/." functor monoid fold)] + ["." list ("#;." functor monoid fold)] ["dict" dictionary (#+ Dictionary)]]]] ["." // #_ ["#." loop (#+ Transform)] - ["#/" // ("#/." monad) + ["#/" // ("#;." monad) ["#/" // #_ ["#." reference (#+ Register Variable)] ["#." analysis (#+ Environment Arity Analysis)] @@ -21,14 +21,14 @@ (exception: #export (cannot-find-foreign-variable-in-environment {foreign Register} {environment Environment}) (ex.report ["Foreign" (%n foreign)] ["Environment" (|> environment - (list/map ////reference.%variable) + (list;map ////reference.%variable) (text.join-with " "))])) (def: arity-arguments (-> Arity (List Synthesis)) (|>> dec (list.n/range 1) - (list/map (|>> /.variable/local)))) + (list;map (|>> /.variable/local)))) (template: #export (self-reference) (/.variable/local 0)) @@ -54,7 +54,7 @@ ## (maybe.default <apply>))) (^ (/.function/apply [funcS' argsS'])) - (wrap (/.function/apply [funcS' (list/compose argsS' argsS)])) + (wrap (/.function/apply [funcS' (list;compose argsS' argsS)])) _ (wrap <apply>))))))) @@ -63,7 +63,7 @@ (-> Environment Register (Operation Variable)) (case (list.nth register environment) (#.Some aliased) - (////wrap aliased) + (///;wrap aliased) #.None (///.throw cannot-find-foreign-variable-in-environment [register environment]))) @@ -72,7 +72,7 @@ (-> (-> Synthesis (Operation Synthesis)) Path (Operation Path)) (case path (#/.Bind register) - (////wrap (#/.Bind (inc register))) + (///;wrap (#/.Bind (inc register))) (^template [<tag>] (<tag> left right) @@ -85,10 +85,10 @@ (#/.Then thenS) (|> thenS grow - (////map (|>> #/.Then))) + (///;map (|>> #/.Then))) _ - (////wrap path))) + (///;wrap path))) (def: (grow-sub-environment super sub) (-> Environment Environment (Operation Environment)) @@ -96,7 +96,7 @@ (function (_ variable) (case variable (#////reference.Local register) - (////wrap (#////reference.Local (inc register))) + (///;wrap (#////reference.Local (inc register))) (#////reference.Foreign register) (find-foreign super register))) @@ -110,30 +110,30 @@ (#////analysis.Variant [lefts right? subS]) (|> subS (grow environment) - (////map (|>> [lefts right?] /.variant))) + (///;map (|>> [lefts right?] /.variant))) (#////analysis.Tuple membersS+) (|> membersS+ (monad.map ///.monad (grow environment)) - (////map (|>> /.tuple)))) + (///;map (|>> /.tuple)))) (^ (..self-reference)) - (////wrap (/.function/apply [expression (list (/.variable/local 1))])) + (///;wrap (/.function/apply [expression (list (/.variable/local 1))])) (#/.Reference reference) (case reference (#////reference.Variable variable) (case variable (#////reference.Local register) - (////wrap (/.variable/local (inc register))) + (///;wrap (/.variable/local (inc register))) (#////reference.Foreign register) (|> register (find-foreign environment) - (////map (|>> /.variable)))) + (///;map (|>> /.variable)))) (#////reference.Constant constant) - (////wrap expression)) + (///;wrap expression)) (#/.Control control) (case control @@ -169,7 +169,7 @@ (#/.Recur argumentsS+) (|> argumentsS+ (monad.map ///.monad (grow environment)) - (////map (|>> /.loop/recur)))) + (///;map (|>> /.loop/recur)))) (#/.Function function) (case function @@ -181,8 +181,8 @@ (#/.Apply funcS argsS+) (case funcS (^ (/.function/apply [(..self-reference) pre-argsS+])) - (////wrap (/.function/apply [(..self-reference) - (list/compose pre-argsS+ argsS+)])) + (///;wrap (/.function/apply [(..self-reference) + (list;compose pre-argsS+ argsS+)])) _ (do ///.monad @@ -193,10 +193,10 @@ (#/.Extension name argumentsS+) (|> argumentsS+ (monad.map ///.monad (grow environment)) - (////map (|>> (#/.Extension name)))) + (///;map (|>> (#/.Extension name)))) _ - (////wrap expression))) + (///;wrap expression))) (def: #export (abstraction phase environment bodyA) (-> Phase Environment Analysis (Operation Synthesis)) diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux index ce5b5e3be..54bec7b03 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux @@ -4,9 +4,9 @@ ["." monad (#+ do)] ["p" parser]] [data - ["." maybe ("#/." monad)] + ["." maybe ("#;." monad)] [collection - ["." list ("#/." functor)]]] + ["." list ("#;." functor)]]] [macro ["." code] ["." syntax]]] @@ -114,10 +114,10 @@ #.None)) (#/.Seq leftS rightS) - (maybe/map (|>> (#/.Seq leftS)) (recur rightS)) + (maybe;map (|>> (#/.Seq leftS)) (recur rightS)) (#/.Then bodyS) - (maybe/map (|>> #/.Then) (synthesis-recursion bodyS)) + (maybe;map (|>> #/.Then) (synthesis-recursion bodyS)) _ #.None))) @@ -133,10 +133,10 @@ (#/.Case inputS pathS) (|> pathS (path-recursion recur) - (maybe/map (|>> (#/.Case inputS) #/.Branch #/.Control))) + (maybe;map (|>> (#/.Case inputS) #/.Branch #/.Control))) (#/.Let inputS register bodyS) - (maybe/map (|>> (#/.Let inputS register) #/.Branch #/.Control) + (maybe;map (|>> (#/.Let inputS register) #/.Branch #/.Control) (recur bodyS)) (#/.If inputS thenS elseS) @@ -187,7 +187,7 @@ ([#/.Alt] [#/.Seq]) (#/.Then bodyS) - (|> bodyS adjust-synthesis (maybe/map (|>> #/.Then))) + (|> bodyS adjust-synthesis (maybe;map (|>> #/.Then))) _ (#.Some pathS)))) @@ -209,7 +209,7 @@ (#////analysis.Tuple membersS+) (|> membersS+ (monad.map maybe.monad recur) - (maybe/map (|>> #////analysis.Tuple #/.Structure)))) + (maybe;map (|>> #////analysis.Tuple #/.Structure)))) (#/.Reference reference) (case reference @@ -222,7 +222,7 @@ (^ (////reference.foreign register)) (|> scope-environment (list.nth register) - (maybe/map (|>> #////reference.Variable #/.Reference)))) + (maybe;map (|>> #////reference.Variable #/.Reference)))) (^ (/.branch/case [inputS pathS])) (do maybe.monad @@ -256,7 +256,7 @@ (^ (/.loop/recur argsS)) (|> argsS (monad.map maybe.monad recur) - (maybe/map (|>> /.loop/recur))) + (maybe;map (|>> /.loop/recur))) (^ (/.function/abstraction [environment arity bodyS])) @@ -275,7 +275,7 @@ (#/.Extension [name argsS]) (|> argsS (monad.map maybe.monad recur) - (maybe/map (|>> [name] #/.Extension))) + (maybe;map (|>> [name] #/.Extension))) _ (#.Some exprS)))) @@ -288,5 +288,5 @@ (proper? bodyS)) (|> bodyS (adjust environment num-locals) - (maybe/map (|>> [(inc num-locals) inits] /.loop/scope))) + (maybe;map (|>> [(inc num-locals) inits] /.loop/scope))) #.None))) |