diff options
Diffstat (limited to 'stdlib/source/lux/tool/compiler/phase')
10 files changed, 284 insertions, 207 deletions
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 cd6ccd83d..dc654fd40 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux @@ -6,9 +6,10 @@ equivalence] [data ["." bit ("#/." equivalence)] - ["." number] ["." error (#+ Error) ("#/." monad)] ["." maybe] + [number + ["." nat]] ["." text format] [collection @@ -144,7 +145,7 @@ (wrap (#Variant (if right? (#.Some idx) #.None) - (|> (dictionary.new number.hash) + (|> (dictionary.new nat.hash) (dictionary.put idx value-coverage))))))) (def: (xor left right) @@ -171,7 +172,7 @@ _ (list coverage))) -(structure: _ (Equivalence Coverage) +(structure: equivalence (Equivalence Coverage) (def: (= reference sample) (case [reference sample] [#Exhaustive #Exhaustive] diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/expression.lux b/stdlib/source/lux/tool/compiler/phase/analysis/expression.lux index 3ce70fe9b..82c9cd65b 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/expression.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/expression.lux @@ -24,86 +24,106 @@ (exception: #export (unrecognized-syntax {code Code}) (ex.report ["Code" (%code code)])) +## TODO: Had to split the 'compile' function due to compilation issues +## with old-luxc. Must re-combine all the code ASAP + +(type: (Fix a) + (-> a a)) + +(def: (compile|primitive else code') + (Fix (-> (Code' (Ann Cursor)) (Operation Analysis))) + (case code' + (^template [<tag> <analyser>] + (<tag> value) + (<analyser> value)) + ([#.Bit primitive.bit] + [#.Nat primitive.nat] + [#.Int primitive.int] + [#.Rev primitive.rev] + [#.Frac primitive.frac] + [#.Text primitive.text]) + + _ + (else code'))) + +(def: (compile|structure compile else code') + (-> Phase (Fix (-> (Code' (Ann Cursor)) (Operation Analysis)))) + (case code' + (^template [<tag> <analyser>] + (^ (#.Form (list& [_ (<tag> tag)] + values))) + (case values + (#.Cons value #.Nil) + (<analyser> compile tag value) + + _ + (<analyser> compile tag (` [(~+ values)])))) + ([#.Nat structure.sum] + [#.Tag structure.tagged-sum]) + + (#.Tag tag) + (structure.tagged-sum compile tag (' [])) + + (^ (#.Tuple (list))) + primitive.unit + + (^ (#.Tuple (list singleton))) + (compile singleton) + + (^ (#.Tuple elems)) + (structure.product compile elems) + + (^ (#.Record pairs)) + (structure.record compile pairs) + + _ + (else code'))) + +(def: (compile|others compile code') + (-> Phase (-> (Code' (Ann Cursor)) (Operation Analysis))) + (case code' + (#.Identifier reference) + (//reference.reference reference) + + (^ (#.Form (list [_ (#.Record branches)] input))) + (case.case compile input branches) + + (^ (#.Form (list& [_ (#.Text extension-name)] extension-args))) + (extension.apply compile [extension-name extension-args]) + + (^ (#.Form (list [_ (#.Tuple (list [_ (#.Identifier ["" function-name])] + [_ (#.Identifier ["" arg-name])]))] + body))) + (function.function compile function-name arg-name body) + + (^ (#.Form (list& functionC argsC+))) + (do ///.monad + [[functionT functionA] (type.with-inference + (compile functionC))] + (case functionA + (#//.Reference (#reference.Constant def-name)) + (do @ + [?macro (extension.lift (macro.find-macro def-name))] + (case ?macro + (#.Some macro) + (do @ + [expansion (extension.lift (//macro.expand-one def-name macro argsC+))] + (compile expansion)) + + _ + (function.apply compile functionT functionA argsC+))) + + _ + (function.apply compile functionT functionA argsC+))) + + _ + (///.throw unrecognized-syntax [.dummy-cursor code']))) + (def: #export (compile code) Phase - (do ///.monad - [expectedT (extension.lift macro.expected-type)] - (let [[cursor code'] code] - ## The cursor must be set in the state for the sake - ## of having useful error messages. - (//.with-cursor cursor - (case code' - (^template [<tag> <analyser>] - (<tag> value) - (<analyser> value)) - ([#.Bit primitive.bit] - [#.Nat primitive.nat] - [#.Int primitive.int] - [#.Rev primitive.rev] - [#.Frac primitive.frac] - [#.Text primitive.text]) - - (^template [<tag> <analyser>] - (^ (#.Form (list& [_ (<tag> tag)] - values))) - (case values - (#.Cons value #.Nil) - (<analyser> compile tag value) - - _ - (<analyser> compile tag (` [(~+ values)])))) - ([#.Nat structure.sum] - [#.Tag structure.tagged-sum]) - - (#.Tag tag) - (structure.tagged-sum compile tag (' [])) - - (^ (#.Tuple (list))) - primitive.unit - - (^ (#.Tuple (list singleton))) - (compile singleton) - - (^ (#.Tuple elems)) - (structure.product compile elems) - - (^ (#.Record pairs)) - (structure.record compile pairs) - - (#.Identifier reference) - (//reference.reference reference) - - (^ (#.Form (list [_ (#.Record branches)] input))) - (case.case compile input branches) - - (^ (#.Form (list& [_ (#.Text extension-name)] extension-args))) - (extension.apply "Analysis" compile [extension-name extension-args]) - - (^ (#.Form (list [_ (#.Tuple (list [_ (#.Identifier ["" function-name])] - [_ (#.Identifier ["" arg-name])]))] - body))) - (function.function compile function-name arg-name body) - - (^ (#.Form (list& functionC argsC+))) - (do @ - [[functionT functionA] (type.with-inference - (compile functionC))] - (case functionA - (#//.Reference (#reference.Constant def-name)) - (do @ - [?macro (extension.lift (macro.find-macro def-name))] - (case ?macro - (#.Some macro) - (do @ - [expansion (extension.lift (//macro.expand-one def-name macro argsC+))] - (compile expansion)) - - _ - (function.apply compile functionT functionA argsC+))) - - _ - (function.apply compile functionT functionA argsC+))) - - _ - (///.throw unrecognized-syntax code) - ))))) + (let [[cursor code'] code] + ## The cursor must be set in the state for the sake + ## of having useful error messages. + (//.with-cursor cursor + (compile|primitive (compile|structure compile (compile|others compile)) + code')))) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/primitive.lux b/stdlib/source/lux/tool/compiler/phase/analysis/primitive.lux index b46983293..b65b6bc96 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/primitive.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/primitive.lux @@ -6,7 +6,6 @@ [".A" type] ["/." //]]) -## [Analysers] (do-template [<name> <type> <tag>] [(def: #export (<name> value) (-> <type> (Operation Analysis)) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux b/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux index 6991c67f7..3fb066259 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux @@ -6,15 +6,16 @@ ["." state]] [data ["." name] - ["." number] ["." product] ["." maybe] ["." error] + [number + ["." nat]] [text format] [collection ["." list ("#/." functor)] - ["dict" dictionary (#+ Dictionary)]]] + ["." dictionary (#+ Dictionary)]]] ["." type ["." check]] ["." macro @@ -311,23 +312,23 @@ (wrap []) (///.throw record-size-mismatch [size-ts size-record recordT record])) #let [tuple-range (list.indices size-ts) - tag->idx (dict.from-list name.hash (list.zip2 tag-set tuple-range))] + tag->idx (dictionary.from-list name.hash (list.zip2 tag-set tuple-range))] idx->val (monad.fold @ (function (_ [key val] idx->val) (do @ [key (extension.lift (macro.normalize key))] - (case (dict.get key tag->idx) + (case (dictionary.get key tag->idx) (#.Some idx) - (if (dict.contains? idx idx->val) + (if (dictionary.contains? idx idx->val) (///.throw cannot-repeat-tag [key record]) - (wrap (dict.put idx val idx->val))) + (wrap (dictionary.put idx val idx->val))) #.None (///.throw tag-does-not-belong-to-record [key recordT])))) (: (Dictionary Nat Code) - (dict.new number.hash)) + (dictionary.new nat.hash)) record) - #let [ordered-tuple (list/map (function (_ idx) (maybe.assume (dict.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/analysis/host.jvm.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.jvm.lux index 0654e79c4..3e44b42f4 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 @@ -561,14 +561,18 @@ (def: (java-type-to-class jvm-type) (-> java/lang/reflect/Type (Operation Text)) - (cond (host.instance? Class jvm-type) - (/////wrap (Class::getName (:coerce Class jvm-type))) + (<| (case (host.check Class jvm-type) + (#.Some jvm-type) + (/////wrap (Class::getName jvm-type)) - (host.instance? ParameterizedType jvm-type) - (java-type-to-class (ParameterizedType::getRawType (:coerce ParameterizedType jvm-type))) + _) + (case (host.check ParameterizedType jvm-type) + (#.Some jvm-type) + (java-type-to-class (ParameterizedType::getRawType jvm-type)) - ## else - (////.throw cannot-convert-to-a-class jvm-type))) + _) + ## else + (////.throw cannot-convert-to-a-class jvm-type))) (type: Mappings (Dictionary Text Type)) @@ -577,8 +581,9 @@ (def: (java-type-to-lux-type mappings java-type) (-> Mappings java/lang/reflect/Type (Operation Type)) - (cond (host.instance? TypeVariable java-type) - (let [var-name (TypeVariable::getName (:coerce TypeVariable java-type))] + (<| (case (host.check TypeVariable java-type) + (#.Some java-type) + (let [var-name (TypeVariable::getName java-type)] (case (dictionary.get var-name mappings) (#.Some var-type) (/////wrap var-type) @@ -586,17 +591,20 @@ #.None (////.throw unknown-type-var var-name))) - (host.instance? WildcardType java-type) - (let [java-type (:coerce WildcardType java-type)] - (case [(array.read 0 (WildcardType::getUpperBounds java-type)) - (array.read 0 (WildcardType::getLowerBounds java-type))] - (^or [(#.Some bound) _] [_ (#.Some bound)]) - (java-type-to-lux-type mappings bound) - - _ - (/////wrap Any))) - - (host.instance? Class java-type) + _) + (case (host.check WildcardType java-type) + (#.Some java-type) + (case [(array.read 0 (WildcardType::getUpperBounds java-type)) + (array.read 0 (WildcardType::getLowerBounds java-type))] + (^or [(#.Some bound) _] [_ (#.Some bound)]) + (java-type-to-lux-type mappings bound) + + _ + (/////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)) @@ -609,11 +617,13 @@ (list/map (|>> (n/* 2) inc #.Parameter)) (#.Primitive class-name) (type.univ-q arity))))) - - (host.instance? ParameterizedType java-type) - (let [java-type (:coerce ParameterizedType java-type) - raw (ParameterizedType::getRawType java-type)] - (if (host.instance? Class raw) + + _) + (case (host.check ParameterizedType java-type) + (#.Some java-type) + (let [raw (ParameterizedType::getRawType java-type)] + (case (host.check Class raw) + (#.Some raw) (do ////.monad [paramsT (|> java-type ParameterizedType::getActualTypeArguments @@ -621,17 +631,22 @@ (monad.map @ (java-type-to-lux-type mappings)))] (/////wrap (#.Primitive (Class::getName (:coerce (Class Object) raw)) paramsT))) - (////.throw jvm-type-is-not-a-class raw))) - (host.instance? GenericArrayType java-type) + _ + (////.throw jvm-type-is-not-a-class raw))) + + _) + (case (host.check GenericArrayType java-type) + (#.Some java-type) (do ////.monad - [innerT (|> (:coerce GenericArrayType java-type) + [innerT (|> java-type GenericArrayType::getGenericComponentType (java-type-to-lux-type mappings))] (wrap (#.Primitive "#Array" (list innerT)))) - - ## else - (////.throw cannot-convert-to-a-lux-type java-type))) + + _) + ## else + (////.throw cannot-convert-to-a-lux-type java-type))) (def: (correspond-type-params class type) (-> (Class Object) Type (Operation Mappings)) @@ -900,23 +915,36 @@ (def: (java-type-to-parameter type) (-> java/lang/reflect/Type (Operation Text)) - (cond (host.instance? Class type) - (/////wrap (Class::getName (:coerce Class type))) - - (host.instance? ParameterizedType type) - (java-type-to-parameter (ParameterizedType::getRawType (:coerce ParameterizedType type))) - - (or (host.instance? TypeVariable type) - (host.instance? WildcardType type)) + (<| (case (host.check Class type) + (#.Some type) + (/////wrap (Class::getName type)) + + _) + (case (host.check ParameterizedType type) + (#.Some type) + (java-type-to-parameter (ParameterizedType::getRawType type)) + + _) + (case (host.check TypeVariable type) + (#.Some type) (/////wrap "java.lang.Object") - - (host.instance? GenericArrayType type) + + _) + (case (host.check WildcardType type) + (#.Some type) + (/////wrap "java.lang.Object") + + _) + (case (host.check GenericArrayType type) + (#.Some type) (do ////.monad - [componentP (java-type-to-parameter (GenericArrayType::getGenericComponentType (:coerce GenericArrayType type)))] + [componentP (java-type-to-parameter (GenericArrayType::getGenericComponentType type))] (wrap (format componentP "[]"))) - - ## else - (////.throw cannot-convert-to-a-parameter type))) + + _) + + ## else + (////.throw cannot-convert-to-a-parameter type))) (type: Method-Style #Static diff --git a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux index 29602faf7..3d944b995 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux @@ -18,10 +18,25 @@ ["." analysis ["." module] ["." type]] - ["." synthesis] + ["." synthesis (#+ Synthesis)] ["." translation] ["." statement (#+ Operation Handler Bundle)]]]) +## TODO: Inline "evaluate!'" into "evaluate!" ASAP +(def: (evaluate!' translate code//type codeS) + (All [anchor expression statement] + (-> (translation.Phase anchor expression statement) + Type + Synthesis + (Operation anchor expression statement [Type expression Any]))) + (statement.lift-translation + (translation.with-buffer + (do ///.monad + [codeT (translate codeS) + count translation.next + codeV (translation.evaluate! (format "evaluate" (%n count)) codeT)] + (wrap [code//type codeT codeV]))))) + (def: (evaluate! type codeC) (All [anchor expression statement] (-> Type Code (Operation anchor expression statement [Type expression Any]))) @@ -39,15 +54,24 @@ (wrap [type codeA])))))) codeS (statement.lift-synthesis (synthesize codeA))] - (statement.lift-translation - (translation.with-buffer - (do @ - [codeT (translate codeS) - count translation.next - codeV (translation.evaluate! (format "evaluate" (%n count)) codeT)] - (wrap [code//type codeT codeV])))))) - -(def: (define! name ?type codeC) + (evaluate!' translate code//type codeS))) + +## TODO: Inline "definition'" into "definition" ASAP +(def: (definition' translate name code//type codeS) + (All [anchor expression statement] + (-> (translation.Phase anchor expression statement) + Name + Type + Synthesis + (Operation anchor expression statement [Type expression Text Any]))) + (statement.lift-translation + (translation.with-buffer + (do ///.monad + [codeT (translate codeS) + codeN+V (translation.define! name codeT)] + (wrap [code//type codeT codeN+V]))))) + +(def: (definition name ?type codeC) (All [anchor expression statement] (-> Name (Maybe Type) Code (Operation anchor expression statement [Type expression Text Any]))) @@ -74,12 +98,23 @@ (wrap [code//type codeA])))))) codeS (statement.lift-synthesis (synthesize codeA))] - (statement.lift-translation - (translation.with-buffer - (do @ - [codeT (translate codeS) - codeN+V (translation.define! name codeT)] - (wrap [code//type codeT codeN+V])))))) + (definition' translate name code//type codeS))) + +(def: (define short-name type annotations value) + (All [anchor expression statement] + (-> Text Type Code Any + (Operation anchor expression statement Any))) + (statement.lift-analysis + (do ///.monad + [_ (module.define short-name [type annotations value])] + (if (macro.type? annotations) + (case (macro.declared-tags annotations) + #.Nil + (wrap []) + + tags + (module.declare-tags tags (macro.export? annotations) (:coerce Type value))) + (wrap []))))) (def: lux::def Handler @@ -91,24 +126,13 @@ (//.lift macro.current-module-name)) #let [full-name [current-module short-name]] [_ annotationsT annotationsV] (evaluate! Code annotationsC) - #let [annotationsV (:coerce Code annotationsV) - type-definition? (macro.type? annotationsV)] - [value//type valueT valueN valueV] (define! full-name - (if type-definition? - (#.Some Type) - #.None) - valueC) - _ (statement.lift-analysis - (do @ - [_ (module.define short-name [value//type annotationsV valueV])] - (if type-definition? - (case (macro.declared-tags annotationsV) - #.Nil - (wrap []) - - tags - (module.declare-tags tags (macro.export? annotationsV) (:coerce Type valueV))) - (wrap [])))) + #let [annotationsV (:coerce Code annotationsV)] + [value//type valueT valueN valueV] (..definition full-name + (if (macro.type? annotationsV) + (#.Some Type) + #.None) + valueC) + _ (..define short-name value//type annotationsV valueV) #let [_ (log! (format "Definition " (%name full-name)))]] (statement.lift-translation (translation.learn full-name valueN))) diff --git a/stdlib/source/lux/tool/compiler/phase/statement/total.lux b/stdlib/source/lux/tool/compiler/phase/statement/total.lux index c494b01c6..542be5408 100644 --- a/stdlib/source/lux/tool/compiler/phase/statement/total.lux +++ b/stdlib/source/lux/tool/compiler/phase/statement/total.lux @@ -28,7 +28,7 @@ Phase (case code (^ [_ (#.Form (list& [_ (#.Text name)] inputs))]) - (extension.apply "Statement" phase [name inputs]) + (extension.apply phase [name inputs]) (^ [_ (#.Form (list& macro inputs))]) (do ///.monad diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux index b1890688d..7c3f2e3ed 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux @@ -2,7 +2,7 @@ [lux #* [control [equivalence (#+ Equivalence)] - pipe + [pipe (#+ when> new> case>)] ["." monad (#+ do)]] [data ["." product] @@ -34,26 +34,26 @@ (^template [<from> <to>] (<from> value) - (///map (|>> (#//.Seq (#//.Test (|> value <to>)))) - thenC)) + (////map (|>> (#//.Seq (#//.Test (|> value <to>)))) + thenC)) ([#analysis.Bit #//.Bit] [#analysis.Nat (<| #//.I64 .i64)] [#analysis.Int (<| #//.I64 .i64)] [#analysis.Rev (<| #//.I64 .i64)] [#analysis.Frac #//.F64] [#analysis.Text #//.Text])) - + (#analysis.Bind register) (<| (:: ///.monad map (|>> (#//.Seq (#//.Bind register)))) //.with-new-local thenC) (#analysis.Complex (#analysis.Variant [lefts right? value-pattern])) - (<| (///map (|>> (#//.Seq (#//.Access (#//.Side (if right? - (#.Right lefts) - (#.Left lefts))))))) + (<| (////map (|>> (#//.Seq (#//.Access (#//.Side (if right? + (#.Right lefts) + (#.Left lefts))))))) (path' value-pattern end?) - (when (not end?) (///map ..clean-up)) + (when> [(new> (not end?) [])] [(////map ..clean-up)]) thenC) (#analysis.Complex (#analysis.Tuple tuple)) @@ -61,18 +61,19 @@ (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? - (#.Right (dec tuple::lefts)) - (#.Left tuple::lefts))))))) + (<| (////map (|>> (#//.Seq (#//.Access (#//.Member (if right? + (#.Right (dec tuple::lefts)) + (#.Left tuple::lefts))))))) (path' tuple::member end?') - (when (not end?') (///map ..clean-up)) + (when> [(new> (not end?') [])] [(////map ..clean-up)]) nextC))) thenC - (list.reverse (list.enumerate tuple)))))) + (list.reverse (list.enumerate tuple)))) + )) (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) diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/expression.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/expression.lux index ac6a82ab8..b19488235 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis/expression.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis/expression.lux @@ -2,7 +2,7 @@ [lux (#- primitive) [control ["." monad (#+ do)] - pipe] + [pipe (#+ case>)]] [data ["." maybe] ["." error] @@ -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) - (:: ///.monad map (|>> //.tuple)))) + (////map (|>> //.tuple)))) (#analysis.Reference reference) - (///wrap (#//.Reference reference)) + (////wrap (#//.Reference reference)) (#analysis.Case inputA branchesAB+) (case.synthesize phase inputA branchesAB+) @@ -73,7 +73,7 @@ (#analysis.Extension name args) (function (_ state) - (|> (extension.apply "Synthesis" phase [name args]) + (|> (extension.apply phase [name args]) (///.run' state) (case> (#error.Success output) (#error.Success output) @@ -83,4 +83,7 @@ (do ///.monad [argsS+ (monad.map @ phase args)] (wrap (#//.Extension [name argsS+]))))))) + + _ + (////wrap (undefined)) )) diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux index ce9efe59b..49764fc08 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux @@ -62,7 +62,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]))) @@ -71,7 +71,7 @@ (-> (-> Synthesis (Operation Synthesis)) Path (Operation Path)) (case path (#//.Bind register) - (///wrap (#//.Bind (inc register))) + (////wrap (#//.Bind (inc register))) (^template [<tag>] (<tag> left right) @@ -84,10 +84,10 @@ (#//.Then thenS) (|> thenS grow - (///map (|>> #//.Then))) + (////map (|>> #//.Then))) _ - (///wrap path))) + (////wrap path))) (def: (grow-sub-environment super sub) (-> Environment Environment (Operation Environment)) @@ -95,7 +95,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))) @@ -109,30 +109,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 @@ -168,7 +168,7 @@ (#//.Recur argumentsS+) (|> argumentsS+ (monad.map ///.monad (grow environment)) - (///map (|>> //.loop/recur)))) + (////map (|>> //.loop/recur)))) (#//.Function function) (case function @@ -180,8 +180,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 @@ -192,10 +192,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)) |