diff options
Diffstat (limited to '')
32 files changed, 297 insertions, 313 deletions
diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index 29e03f5cd..1c75474cf 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -5,16 +5,16 @@ [abstract [monad (.only do)]] [control + ["<>" parser] ["[0]" pipe] ["[0]" try (.only Try)] - ["[0]" exception (.only exception:)] - ["<>" parser (.only) - ["<[0]>" binary (.only Parser)]]] + ["[0]" exception (.only exception:)]] [data ["[0]" product] ["[0]" binary (.only Binary) ["[1]!" \\unsafe] - ["[0]" \\format (.only Writer) (.open: "[1]#[0]" monoid)]] + ["[0]" \\format (.only Writer) (.open: "[1]#[0]" monoid)] + ["<[1]>" \\parser (.only Parser)]] ["[0]" text (.only Char) ["%" \\format (.only format)] [encoding diff --git a/stdlib/source/library/lux/extension.lux b/stdlib/source/library/lux/extension.lux index 51ca6a3d3..424cfcba8 100644 --- a/stdlib/source/library/lux/extension.lux +++ b/stdlib/source/library/lux/extension.lux @@ -5,8 +5,7 @@ ["[0]" monad]] [control ["<>" parser (.open: "[1]#[0]" monad) - ["<c>" code (.only Parser)] - ["<s>" synthesis]]] + ["<c>" code (.only Parser)]]] [data ["[0]" product] [collection @@ -20,7 +19,9 @@ [language [lux [analysis - ["<a>" \\parser]]]]]]]]) + ["<a>" \\parser]] + [synthesis + ["<s>" \\parser]]]]]]]]) (type: Declaration (Record diff --git a/stdlib/source/library/lux/tool/compiler.lux b/stdlib/source/library/lux/tool/compiler.lux index 7e1bfc2c3..2912dc635 100644 --- a/stdlib/source/library/lux/tool/compiler.lux +++ b/stdlib/source/library/lux/tool/compiler.lux @@ -2,14 +2,14 @@ [library [lux (.except Module Code) [control + ["<>" parser (.only)] ["[0]" try (.only Try)] - ["[0]" exception (.only exception:)] - ["<>" parser (.only) - ["<[0]>" binary (.only Parser)]]] + ["[0]" exception (.only exception:)]] [data ["[0]" text] - [binary (.only Binary) - [\\format (.only Writer)]]] + ["[0]" binary (.only Binary) + [\\format (.only Writer)] + ["<[1]>" \\parser (.only Parser)]]] [world ["[0]" file (.only Path)]]]] [/ diff --git a/stdlib/source/library/lux/tool/compiler/language/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux.lux index a5c8c9167..084348037 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux.lux @@ -2,11 +2,11 @@ [library [lux (.except) [control - ["<>" parser (.only) - ["<[0]>" binary (.only Parser)]]] + ["<>" parser]] [data - [binary - ["_" \\format (.only Writer)]]] + ["[0]" binary + ["_" \\format (.only Writer)] + ["<[1]>" \\parser (.only Parser)]]] [meta ["[0]" version]]]] ["[0]" / diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux index 957b2339d..41076ca66 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux @@ -9,8 +9,7 @@ ["[0]" try (.only Try) (.open: "[1]#[0]" functor)] ["[0]" exception] ["<>" parser (.open: "[1]#[0]" monad) - ["<[0]>" code (.only Parser)] - ["<[0]>" synthesis]]] + ["<[0]>" code (.only Parser)]]] [data ["[0]" product] [binary (.only Binary) @@ -64,12 +63,13 @@ ["[1]" artifact]]]] [language [lux - ["[0]" synthesis (.only Synthesis)] ["[0]" generation] ["[0]" directive (.only Handler Bundle)] ["[0]" analysis (.only Analysis) ["[0]A" type] ["[0]A" scope]] + ["[0]" synthesis (.only Synthesis) + ["<[1]>" \\parser]] [phase [generation [jvm @@ -689,16 +689,16 @@ (try#each (|>> (\\format.result class.writer) [name]) (class.class version.v6_0 - (all modifier#composite - class.public - modifier) - (name.internal name) - {.#Some signature} - (..class_name super) - (list#each ..class_name interfaces) - fields - methods - sequence.empty)))) + (all modifier#composite + class.public + modifier) + (name.internal name) + {.#Some signature} + (..class_name super) + (list#each ..class_name interfaces) + fields + methods + sequence.empty)))) (def: (mock_value valueT) (-> (Type Value) (Bytecode Any)) @@ -906,16 +906,16 @@ bytecode (<| (at ! each (\\format.result class.writer)) phase.lifted (class.class version.v6_0 - (all modifier#composite - class.public - inheritance) - (name.internal name) - {.#Some type_declaration} - (..class_name super) - (list#each ..class_name interfaces) - (list#each ..field_definition fields) - (list#each product.right methods) - sequence.empty)) + (all modifier#composite + class.public + inheritance) + (name.internal name) + {.#Some type_declaration} + (..class_name super) + (list#each ..class_name interfaces) + (list#each ..field_definition fields) + (list#each product.right methods) + sequence.empty)) _ (..save_class! name bytecode all_dependencies)] (in directive.no_requirements)))])) @@ -945,19 +945,19 @@ [bytecode (<| (at ! each (\\format.result class.writer)) phase.lifted (class.class version.v6_0 - (all modifier#composite - class.public - class.abstract - class.interface) - (name.internal name) - {.#Some (signature.inheritance (list#each type.signature parameters) - (type.signature $Object) - (list#each type.signature supers))} - (name.internal "java.lang.Object") - (list#each ..class_name supers) - (list) - (list#each ..method_declaration method_declarations) - sequence.empty)) + (all modifier#composite + class.public + class.abstract + class.interface) + (name.internal name) + {.#Some (signature.inheritance (list#each type.signature parameters) + (type.signature $Object) + (list#each type.signature supers))} + (name.internal "java.lang.Object") + (list#each ..class_name supers) + (list) + (list#each ..method_declaration method_declarations) + sequence.empty)) artifact_id (generation.learn_custom name unit.none) .let [artifact [name bytecode]] _ (generation.execute! artifact) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux index 9452e620b..c0c04d708 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux @@ -4,10 +4,9 @@ [abstract ["[0]" monad (.only do)]] [control + ["<>" parser] ["[0]" function] - ["[0]" try] - ["<>" parser (.only) - ["<s>" synthesis (.only Parser)]]] + ["[0]" try]] [data ["[0]" product] ["[0]" text (.only) @@ -33,8 +32,9 @@ ["[1][0]" runtime (.only Operation Phase Handler Bundle Generator)] ["[1][0]" case]]] [// - ["[0]" synthesis (.only %synthesis)] ["[0]" generation] + ["[0]" synthesis (.only %synthesis) + ["<s>" \\parser (.only Parser)]] [/// ["[1]" phase]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/host.lux index 2b7bb2062..79e422867 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/host.lux @@ -1,37 +1,12 @@ (.using [library - [lux (.except) - [abstract - ["[0]" monad (.only do)]] - [control - ["[0]" function] - ["<>" parser (.only) - ["<s>" synthesis (.only Parser)]]] - [data - [collection - ["[0]" dictionary] - ["[0]" list]] - [text - ["%" \\format (.only format)]]] - [target - ["_" common_lisp (.only Var Expression)]]]] - ["[0]" // - ["[1][0]" common (.only custom)] - ["//[1]" /// - ["/" bundle] - ["/[1]" // - ["[0]" extension] - [generation - [extension (.only Nullary Unary Binary Trinary - nullary unary binary trinary)] - ["[0]" reference] - ["//" common_lisp - ["[1][0]" runtime (.only Operation Phase Handler Bundle - with_vars)]]] - ["/[1]" // - ["[0]" generation] - ["//[1]" /// - ["[1][0]" phase]]]]]]) + [lux (.except)]] + [//// + ["/" bundle] + [// + [generation + [common_lisp + [runtime (.only Bundle)]]]]]) (def: .public bundle Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux index 0b40aa0d3..f83d48372 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux @@ -4,9 +4,8 @@ [abstract ["[0]" monad (.only do)]] [control - ["[0]" try] - ["<>" parser (.only) - ["<s>" synthesis (.only Parser)]]] + ["<>" parser] + ["[0]" try]] [data ["[0]" product] [collection @@ -35,7 +34,8 @@ ["[1][0]" loop] ["[1][0]" function]]] [// - ["[0]" synthesis (.only %synthesis)] + ["[0]" synthesis (.only %synthesis) + ["<s>" \\parser (.only Parser)]] [/// ["[1]" phase (.open: "[1]#[0]" monad)]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux index da40355f3..0c3a868ae 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux @@ -4,9 +4,8 @@ [abstract ["[0]" monad (.only do)]] [control - ["[0]" function] - ["<>" parser (.only) - ["<s>" synthesis (.only Parser)]]] + ["<>" parser] + ["[0]" function]] [data [collection ["[0]" dictionary] @@ -27,6 +26,8 @@ with_vars)]]] ["/[1]" // ["[0]" generation] + [synthesis + ["<s>" \\parser (.only Parser)]] ["//[1]" /// ["[1][0]" phase]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux index 7d035fe2f..44e2b7c41 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux @@ -4,10 +4,9 @@ [abstract ["[0]" monad (.only do)]] [control + ["<>" parser] ["[0]" try] - ["[0]" exception (.only exception:)] - ["<>" parser (.only) - ["<[0]>" synthesis (.only Parser)]]] + ["[0]" exception (.only exception:)]] [data ["[0]" product] [collection @@ -37,7 +36,8 @@ ["[1]extension" /] ["[1][0]" bundle]] [// - ["/[1][0]" synthesis (.only Synthesis %synthesis)] + ["[0]" synthesis (.only Synthesis %synthesis) + ["<[1]>" \\parser (.only Parser)]] [/// ["[1]" phase] [meta @@ -54,7 +54,7 @@ (handler extension_name phase archive input') {try.#Failure error} - (/////.except /////extension.invalid_syntax [extension_name //////synthesis.%synthesis input])))) + (/////.except /////extension.invalid_syntax [extension_name synthesis.%synthesis input])))) (def: $Boolean (type.class "java.lang.Boolean" (list))) (def: $Double (type.class "java.lang.Double" (list))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux index 30ef58a77..e08b2aba8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -4,10 +4,9 @@ [abstract ["[0]" monad (.only do)]] [control + ["<>" parser] ["[0]" maybe (.open: "[1]#[0]" functor)] - ["[0]" exception (.only exception:)] - ["<>" parser (.only) - ["<[0]>" synthesis (.only Parser)]]] + ["[0]" exception (.only exception:)]] [data ["[0]" product] [binary @@ -64,8 +63,9 @@ [analysis ["/" jvm]]] ["/[1]" // - ["[1][0]" synthesis (.only Synthesis Path %synthesis)] ["[1][0]" generation] + ["[0]" synthesis (.only Synthesis Path %synthesis) + ["<[1]>" \\parser (.only Parser)]] [analysis (.only Environment) ["[0]" complex]] [/// @@ -653,7 +653,7 @@ (at //////.monad in (_.getstatic (type.class class (list)) field :unboxed:)))])) (def: unitG - (_.string //////synthesis.unit)) + (_.string synthesis.unit)) (def: put::static Handler @@ -823,22 +823,22 @@ (def: .public (hidden_method_body arity body) (-> Nat Synthesis Synthesis) - (with_expansions [<oops> (panic! (%.format (%.nat arity) " " (//////synthesis.%synthesis body)))] + (with_expansions [<oops> (panic! (%.format (%.nat arity) " " (synthesis.%synthesis body)))] (case [arity body] (^.or [0 _] [1 _]) body - (pattern [2 {//////synthesis.#Control {//////synthesis.#Branch {//////synthesis.#Let _ 2 (//////synthesis.tuple (list _ hidden))}}}]) + (pattern [2 {synthesis.#Control {synthesis.#Branch {synthesis.#Let _ 2 (synthesis.tuple (list _ hidden))}}}]) hidden - [_ {//////synthesis.#Control {//////synthesis.#Branch {//////synthesis.#Case _ path}}}] + [_ {synthesis.#Control {synthesis.#Branch {synthesis.#Case _ path}}}] (loop (again [path (is Path path)]) (case path - {//////synthesis.#Seq _ next} + {synthesis.#Seq _ next} (again next) - (pattern {//////synthesis.#Then (//////synthesis.tuple (list _ hidden))}) + (pattern {synthesis.#Then (synthesis.tuple (list _ hidden))}) hidden _ @@ -852,43 +852,43 @@ (-> Path Path)) (function (again it) (case it - (^.or {//////synthesis.#Pop} - {//////synthesis.#Access _}) + (^.or {synthesis.#Pop} + {synthesis.#Access _}) it - {//////synthesis.#Bind it} - {//////synthesis.#Bind (-- it)} + {synthesis.#Bind it} + {synthesis.#Bind (-- it)} - {//////synthesis.#Bit_Fork when then else} - {//////synthesis.#Bit_Fork when - (again then) - (maybe#each again else)} + {synthesis.#Bit_Fork when then else} + {synthesis.#Bit_Fork when + (again then) + (maybe#each again else)} (^.with_template [<tag>] [{<tag> [head tail]} - {<tag> [(revised //////synthesis.#then again head) - (list#each (revised //////synthesis.#then again) tail)]}]) - ([//////synthesis.#I64_Fork] - [//////synthesis.#F64_Fork] - [//////synthesis.#Text_Fork]) + {<tag> [(revised synthesis.#then again head) + (list#each (revised synthesis.#then again) tail)]}]) + ([synthesis.#I64_Fork] + [synthesis.#F64_Fork] + [synthesis.#Text_Fork]) (^.with_template [<tag>] [{<tag> left right} {<tag> (again left) (again right)}]) - ([//////synthesis.#Seq] - [//////synthesis.#Alt]) + ([synthesis.#Seq] + [synthesis.#Alt]) - {//////synthesis.#Then it} - {//////synthesis.#Then (without_fake_parameter it)}))) + {synthesis.#Then it} + {synthesis.#Then (without_fake_parameter it)}))) (def: .public (without_fake_parameter it) (-> Synthesis Synthesis) (case it - {//////synthesis.#Simple _} + {synthesis.#Simple _} it - {//////synthesis.#Structure it} - {//////synthesis.#Structure + {synthesis.#Structure it} + {synthesis.#Structure (case it {complex.#Variant it} {complex.#Variant (revised complex.#value without_fake_parameter it)} @@ -896,8 +896,8 @@ {complex.#Tuple it} {complex.#Tuple (list#each without_fake_parameter it)})} - {//////synthesis.#Reference it} - {//////synthesis.#Reference + {synthesis.#Reference it} + {synthesis.#Reference (case it {//////reference.#Variable it} {//////reference.#Variable @@ -911,64 +911,64 @@ {//////reference.#Constant _} it)} - {//////synthesis.#Control it} - {//////synthesis.#Control + {synthesis.#Control it} + {synthesis.#Control (case it - {//////synthesis.#Branch it} - {//////synthesis.#Branch + {synthesis.#Branch it} + {synthesis.#Branch (case it - {//////synthesis.#Exec before after} - {//////synthesis.#Exec (without_fake_parameter before) - (without_fake_parameter after)} + {synthesis.#Exec before after} + {synthesis.#Exec (without_fake_parameter before) + (without_fake_parameter after)} - {//////synthesis.#Let value register body} - {//////synthesis.#Let (without_fake_parameter value) - (-- register) - (without_fake_parameter body)} + {synthesis.#Let value register body} + {synthesis.#Let (without_fake_parameter value) + (-- register) + (without_fake_parameter body)} - {//////synthesis.#If when then else} - {//////synthesis.#If (without_fake_parameter when) - (without_fake_parameter then) - (without_fake_parameter else)} + {synthesis.#If when then else} + {synthesis.#If (without_fake_parameter when) + (without_fake_parameter then) + (without_fake_parameter else)} - {//////synthesis.#Get members record} - {//////synthesis.#Get members - (without_fake_parameter record)} + {synthesis.#Get members record} + {synthesis.#Get members + (without_fake_parameter record)} - {//////synthesis.#Case value path} - {//////synthesis.#Case (without_fake_parameter value) - (without_fake_parameter#path without_fake_parameter path)})} + {synthesis.#Case value path} + {synthesis.#Case (without_fake_parameter value) + (without_fake_parameter#path without_fake_parameter path)})} - {//////synthesis.#Loop it} - {//////synthesis.#Loop + {synthesis.#Loop it} + {synthesis.#Loop (case it - {//////synthesis.#Scope [//////synthesis.#start start - //////synthesis.#inits inits - //////synthesis.#iteration iteration]} - {//////synthesis.#Scope [//////synthesis.#start (-- start) - //////synthesis.#inits (list#each without_fake_parameter inits) - //////synthesis.#iteration iteration]} + {synthesis.#Scope [synthesis.#start start + synthesis.#inits inits + synthesis.#iteration iteration]} + {synthesis.#Scope [synthesis.#start (-- start) + synthesis.#inits (list#each without_fake_parameter inits) + synthesis.#iteration iteration]} - {//////synthesis.#Again _} + {synthesis.#Again _} it)} - {//////synthesis.#Function it} - {//////synthesis.#Function + {synthesis.#Function it} + {synthesis.#Function (case it - {//////synthesis.#Abstraction [//////synthesis.#environment environment - //////synthesis.#arity arity - //////synthesis.#body body]} - {//////synthesis.#Abstraction [//////synthesis.#environment (list#each without_fake_parameter environment) - //////synthesis.#arity arity - //////synthesis.#body body]} + {synthesis.#Abstraction [synthesis.#environment environment + synthesis.#arity arity + synthesis.#body body]} + {synthesis.#Abstraction [synthesis.#environment (list#each without_fake_parameter environment) + synthesis.#arity arity + synthesis.#body body]} - {//////synthesis.#Apply [//////synthesis.#function function - //////synthesis.#arguments arguments]} - {//////synthesis.#Apply [//////synthesis.#function (without_fake_parameter function) - //////synthesis.#arguments (list#each without_fake_parameter arguments)]})})} + {synthesis.#Apply [synthesis.#function function + synthesis.#arguments arguments]} + {synthesis.#Apply [synthesis.#function (without_fake_parameter function) + synthesis.#arguments (list#each without_fake_parameter arguments)]})})} - {//////synthesis.#Extension name parameters} - {//////synthesis.#Extension name (list#each without_fake_parameter parameters)})) + {synthesis.#Extension name parameters} + {synthesis.#Extension name (list#each without_fake_parameter parameters)})) (def: overriden_method_definition (Parser [(Environment Synthesis) (/.Overriden_Method Synthesis)]) @@ -1003,24 +1003,24 @@ (-> Path Path)) (function (again path) (case path - (pattern (//////synthesis.path/then bodyS)) - (//////synthesis.path/then (normalize bodyS)) + (pattern (synthesis.path/then bodyS)) + (synthesis.path/then (normalize bodyS)) (^.with_template [<tag>] [(pattern {<tag> leftP rightP}) {<tag> (again leftP) (again rightP)}]) - ([//////synthesis.#Alt] - [//////synthesis.#Seq]) + ([synthesis.#Alt] + [synthesis.#Seq]) (^.with_template [<tag>] [{<tag> _} path]) - ([//////synthesis.#Pop] - [//////synthesis.#Bind] - [//////synthesis.#Access]) + ([synthesis.#Pop] + [synthesis.#Bind] + [synthesis.#Access]) - {//////synthesis.#Bit_Fork when then else} - {//////synthesis.#Bit_Fork when (again then) (maybe#each again else)} + {synthesis.#Bit_Fork when then else} + {synthesis.#Bit_Fork when (again then) (maybe#each again else)} (^.with_template [<tag>] [{<tag> [[exampleH nextH] tail]} @@ -1028,9 +1028,9 @@ (list#each (function (_ [example next]) [example (again next)]) tail)]}]) - ([//////synthesis.#I64_Fork] - [//////synthesis.#F64_Fork] - [//////synthesis.#Text_Fork])))) + ([synthesis.#I64_Fork] + [synthesis.#F64_Fork] + [synthesis.#Text_Fork])))) (type: Mapping (Dictionary Synthesis Variable)) @@ -1042,62 +1042,62 @@ (^.with_template [<tag>] [(pattern <tag>) body]) - ([{//////synthesis.#Simple _}] - [(//////synthesis.constant _)]) + ([{synthesis.#Simple _}] + [(synthesis.constant _)]) - (pattern (//////synthesis.variant [lefts right? sub])) - (//////synthesis.variant [lefts right? (again sub)]) + (pattern (synthesis.variant [lefts right? sub])) + (synthesis.variant [lefts right? (again sub)]) - (pattern (//////synthesis.tuple members)) - (//////synthesis.tuple (list#each again members)) + (pattern (synthesis.tuple members)) + (synthesis.tuple (list#each again members)) - (pattern (//////synthesis.variable var)) + (pattern (synthesis.variable var)) (|> mapping (dictionary.value body) (maybe.else var) - //////synthesis.variable) + synthesis.variable) - (pattern (//////synthesis.branch/case [inputS pathS])) - (//////synthesis.branch/case [(again inputS) (normalize_path again pathS)]) + (pattern (synthesis.branch/case [inputS pathS])) + (synthesis.branch/case [(again inputS) (normalize_path again pathS)]) - (pattern (//////synthesis.branch/exec [this that])) - (//////synthesis.branch/exec [(again this) (again that)]) + (pattern (synthesis.branch/exec [this that])) + (synthesis.branch/exec [(again this) (again that)]) - (pattern (//////synthesis.branch/let [inputS register outputS])) - (//////synthesis.branch/let [(again inputS) register (again outputS)]) + (pattern (synthesis.branch/let [inputS register outputS])) + (synthesis.branch/let [(again inputS) register (again outputS)]) - (pattern (//////synthesis.branch/if [testS thenS elseS])) - (//////synthesis.branch/if [(again testS) (again thenS) (again elseS)]) + (pattern (synthesis.branch/if [testS thenS elseS])) + (synthesis.branch/if [(again testS) (again thenS) (again elseS)]) - (pattern (//////synthesis.branch/get [path recordS])) - (//////synthesis.branch/get [path (again recordS)]) + (pattern (synthesis.branch/get [path recordS])) + (synthesis.branch/get [path (again recordS)]) - (pattern (//////synthesis.loop/scope [offset initsS+ bodyS])) - (//////synthesis.loop/scope [offset (list#each again initsS+) (again bodyS)]) + (pattern (synthesis.loop/scope [offset initsS+ bodyS])) + (synthesis.loop/scope [offset (list#each again initsS+) (again bodyS)]) - (pattern (//////synthesis.loop/again updatesS+)) - (//////synthesis.loop/again (list#each again updatesS+)) + (pattern (synthesis.loop/again updatesS+)) + (synthesis.loop/again (list#each again updatesS+)) - (pattern (//////synthesis.function/abstraction [environment arity bodyS])) - (//////synthesis.function/abstraction [(list#each (function (_ captured) - (case captured - (pattern (//////synthesis.variable var)) - (|> mapping - (dictionary.value captured) - (maybe.else var) - //////synthesis.variable) + (pattern (synthesis.function/abstraction [environment arity bodyS])) + (synthesis.function/abstraction [(list#each (function (_ captured) + (case captured + (pattern (synthesis.variable var)) + (|> mapping + (dictionary.value captured) + (maybe.else var) + synthesis.variable) - _ - captured)) - environment) - arity - bodyS]) + _ + captured)) + environment) + arity + bodyS]) - (pattern (//////synthesis.function/apply [functionS inputsS+])) - (//////synthesis.function/apply [(again functionS) (list#each again inputsS+)]) + (pattern (synthesis.function/apply [functionS inputsS+])) + (synthesis.function/apply [(again functionS) (list#each again inputsS+)]) - {//////synthesis.#Extension [name inputsS+]} - {//////synthesis.#Extension [name (list#each again inputsS+)]}))) + {synthesis.#Extension [name inputsS+]} + {synthesis.#Extension [name (list#each again inputsS+)]}))) (def: $Object (type.class "java.lang.Object" (list))) @@ -1273,11 +1273,11 @@ local_mapping (|> environment list.enumeration (list#each (function (_ [foreign_id capture]) - [(//////synthesis.variable/foreign foreign_id) + [(synthesis.variable/foreign foreign_id) (|> global_mapping (dictionary.value capture) maybe.trusted)])) - (dictionary.of_list //////synthesis.hash))] + (dictionary.of_list synthesis.hash))] [ownerT name strict_fp? annotations vars self_name arguments returnT exceptionsT @@ -1292,7 +1292,7 @@ ... Combine them. list#conjoint ... Remove duplicates. - (set.of_list //////synthesis.hash) + (set.of_list synthesis.hash) set.list)) (def: (global_mapping total_environment) @@ -1302,7 +1302,7 @@ list.enumeration (list#each (function (_ [id capture]) [capture {//////variable.#Foreign id}])) - (dictionary.of_list //////synthesis.hash))) + (dictionary.of_list synthesis.hash))) (def: (method_definition phase archive artifact_id method) (-> Phase Archive artifact.ID (/.Overriden_Method Synthesis) (Operation (Resource Method))) @@ -1353,14 +1353,14 @@ bytecode (<| (at ! each (\\format.result class.writer)) //////.lifted (class.class version.v6_0 (all modifier#composite class.public class.final) - (name.internal anonymous_class_name) - {.#None} - (name.internal (..reflection super_class)) - (list#each (|>> ..reflection name.internal) super_interfaces) - (foreign.variables total_environment) - (list.partial (..with_anonymous_init class total_environment super_class inputsTI) - methods!) - (sequence.sequence))) + (name.internal anonymous_class_name) + {.#None} + (name.internal (..reflection super_class)) + (list#each (|>> ..reflection name.internal) super_interfaces) + (foreign.variables total_environment) + (list.partial (..with_anonymous_init class total_environment super_class inputsTI) + methods!) + (sequence.sequence))) .let [artifact [anonymous_class_name bytecode]] _ (//////generation.execute! artifact) _ (//////generation.save! artifact_id {.#None} artifact)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux index d3d7c76d6..c454fc422 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux @@ -4,10 +4,9 @@ [abstract ["[0]" monad (.only do)]] [control + ["<>" parser] ["[0]" function] - ["[0]" try] - ["<>" parser (.only) - ["<s>" synthesis (.only Parser)]]] + ["[0]" try]] [data ["[0]" product] ["[0]" text @@ -38,8 +37,9 @@ ["[1][0]" loop] ["[1][0]" function]]] [// - ["[0]" synthesis (.only %synthesis)] ["[0]" generation] + ["[0]" synthesis (.only %synthesis) + ["<s>" \\parser (.only Parser)]] [/// ["[1]" phase (.open: "[1]#[0]" monad)]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux index f2a8e2938..4ed8013ca 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux @@ -4,9 +4,8 @@ [abstract ["[0]" monad (.only do)]] [control - ["[0]" function] - ["<>" parser (.only) - ["<s>" synthesis (.only Parser)]]] + ["<>" parser] + ["[0]" function]] [data [collection ["[0]" dictionary] @@ -30,6 +29,8 @@ with_vars)]]] ["/[1]" // ["[0]" generation] + [synthesis + ["<s>" \\parser (.only Parser)]] ["//[1]" /// ["[1][0]" phase]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux index 898a3e8b0..384736271 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux @@ -4,10 +4,9 @@ [abstract ["[0]" monad (.only do)]] [control + ["<>" parser] ["[0]" function] - ["[0]" try] - ["<>" parser (.only) - ["<s>" synthesis (.only Parser)]]] + ["[0]" try]] [data ["[0]" product] ["[0]" text (.only) @@ -33,7 +32,8 @@ ["[1][0]" runtime (.only Operation Phase Handler Bundle Generator)] ["[1][0]" case]]] [// - ["[0]" synthesis (.only %synthesis)] + ["[0]" synthesis (.only %synthesis) + ["<s>" \\parser (.only Parser)]] ["[0]" generation] [/// ["[1]" phase]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux index 353c6d055..535f01072 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux @@ -4,9 +4,8 @@ [abstract ["[0]" monad (.only do)]] [control - ["[0]" function] - ["<>" parser (.only) - ["<s>" synthesis (.only Parser)]]] + ["<>" parser] + ["[0]" function]] [data [collection ["[0]" dictionary] @@ -30,6 +29,8 @@ with_vars)]]] ["/[1]" // ["[0]" generation] + [synthesis + ["<s>" \\parser (.only Parser)]] ["//[1]" /// ["[1][0]" phase]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux index 933f52e74..ef6d301bc 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux @@ -4,10 +4,9 @@ [abstract ["[0]" monad (.only do)]] [control + ["<>" parser] ["[0]" function] - ["[0]" try] - ["<>" parser (.only) - ["<[0]>" synthesis (.only Parser)]]] + ["[0]" try]] [data ["[0]" product] ["[0]" text (.only) @@ -40,8 +39,9 @@ ["[1][0]" loop]]] [// [analysis (.only)] - ["[0]" synthesis (.only %synthesis)] ["[0]" generation] + ["[0]" synthesis (.only %synthesis) + ["<[1]>" \\parser (.only Parser)]] [/// ["[1]" phase (.open: "[1]#[0]" monad)]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux index e62529746..7ec9d1083 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux @@ -4,9 +4,8 @@ [abstract ["[0]" monad (.only do)]] [control - ["[0]" function] - ["<>" parser (.only) - ["<s>" synthesis (.only Parser)]]] + ["<>" parser] + ["[0]" function]] [data ["[0]" text (.only) ["%" \\format]] @@ -29,6 +28,8 @@ with_vars)]]] ["/[1]" // ["[0]" generation] + [synthesis + ["<s>" \\parser (.only Parser)]] ["//[1]" /// ["[1][0]" phase]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux index 530f76072..facbc2e58 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux @@ -4,10 +4,9 @@ [abstract ["[0]" monad (.only do)]] [control + ["<>" parser] ["[0]" function] - ["[0]" try] - ["<>" parser (.only) - ["<s>" synthesis (.only Parser)]]] + ["[0]" try]] [data ["[0]" product] ["[0]" text (.only) @@ -33,7 +32,8 @@ ["[1][0]" runtime (.only Operation Phase Handler Bundle Generator)] ["[1][0]" case]]] [// - ["[0]" synthesis (.only %synthesis)] + ["[0]" synthesis (.only %synthesis) + ["<s>" \\parser (.only Parser)]] ["[0]" generation] [/// ["[1]" phase]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/host.lux index d03538b0b..8facd6a1a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/host.lux @@ -4,9 +4,8 @@ [abstract ["[0]" monad (.only do)]] [control - ["[0]" function] - ["<>" parser (.only) - ["<s>" synthesis (.only Parser)]]] + ["<>" parser] + ["[0]" function]] [data [collection ["[0]" dictionary] @@ -30,6 +29,8 @@ with_vars)]]] ["/[1]" // ["[0]" generation] + [synthesis + ["<s>" \\parser (.only Parser)]] ["//[1]" /// ["[1][0]" phase]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux index 07d25add0..6cdacfa40 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux @@ -4,10 +4,9 @@ [abstract ["[0]" monad (.only do)]] [control + ["<>" parser] ["[0]" function] - ["[0]" try] - ["<>" parser (.only) - ["<s>" synthesis (.only Parser)]]] + ["[0]" try]] [data ["[0]" product] ["[0]" text (.only) @@ -38,8 +37,9 @@ ["[1][0]" case] ["[1][0]" loop]]] [// - ["[0]" synthesis (.only %synthesis)] ["[0]" generation] + ["[0]" synthesis (.only %synthesis) + ["<s>" \\parser (.only Parser)]] [/// ["[1]" phase (.open: "[1]#[0]" monad)]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux index 7dcf5c1cb..89638f972 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux @@ -4,9 +4,8 @@ [abstract ["[0]" monad (.only do)]] [control - ["[0]" function] - ["<>" parser (.only) - ["<s>" synthesis (.only Parser)]]] + ["<>" parser] + ["[0]" function]] [data [collection ["[0]" dictionary] @@ -30,6 +29,8 @@ with_vars)]]] ["/[1]" // ["[0]" generation] + [synthesis + ["<s>" \\parser (.only Parser)]] ["//[1]" /// ["[1][0]" phase]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux index 0ed822b89..5d4801be1 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux @@ -4,10 +4,9 @@ [abstract ["[0]" monad (.only do)]] [control + ["<>" parser] ["[0]" function] - ["[0]" try] - ["<>" parser (.only) - ["<s>" synthesis (.only Parser)]]] + ["[0]" try]] [data ["[0]" product] ["[0]" text @@ -33,8 +32,9 @@ ["[1][0]" runtime (.only Operation Phase Handler Bundle Generator)] ["[1][0]" case]]] [// - ["[0]" synthesis (.only %synthesis)] ["[0]" generation] + ["[0]" synthesis (.only %synthesis) + ["<s>" \\parser (.only Parser)]] [/// ["[1]" phase]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux index f14556827..862df2607 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux @@ -4,9 +4,8 @@ [abstract ["[0]" monad (.only do)]] [control - ["[0]" function] - ["<>" parser (.only) - ["<s>" synthesis (.only Parser)]]] + ["<>" parser] + ["[0]" function]] [data [collection ["[0]" dictionary] @@ -30,6 +29,8 @@ with_vars)]]] ["/[1]" // ["[0]" generation] + [synthesis + ["<s>" \\parser (.only Parser)]] ["//[1]" /// ["[1][0]" phase]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index fd47dbe30..92c263466 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -5,16 +5,16 @@ ["[0]" equivalence (.only Equivalence)] ["[0]" monad (.only do)]] [control + ["<>" parser] ["[0]" maybe] ["[0]" try (.only Try)] ["[0]" exception (.only exception:)] - ["[0]" function] - ["<>" parser (.only) - ["<[0]>" binary (.only Parser)]]] + ["[0]" function]] [data ["[0]" product] - [binary (.only Binary) - ["[0]" \\format (.only Writer)]] + ["[0]" binary (.only Binary) + ["[0]" \\format (.only Writer)] + ["<[1]>" \\parser (.only Parser)]] ["[0]" text (.only) ["%" \\format (.only format)]] [collection diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/module/descriptor.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/module/descriptor.lux index 75934414f..b661a1587 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/module/descriptor.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/module/descriptor.lux @@ -4,13 +4,13 @@ [abstract [equivalence (.only Equivalence)]] [control - ["<>" parser (.only) - ["<[0]>" binary (.only Parser)]]] + ["<>" parser]] [data ["[0]" product] ["[0]" text] - [binary - ["[0]" \\format (.only Writer)]] + ["[0]" binary + ["[0]" \\format (.only Writer)] + ["<[1]>" \\parser (.only Parser)]] [collection ["[0]" set (.only Set)]]] [macro diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux index 684277ae4..ef3073cca 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux @@ -4,14 +4,14 @@ [abstract [monad (.only do)]] [control + ["<>" parser] ["[0]" try (.only Try)] - ["[0]" exception (.only exception:)] - ["<>" parser (.only) - [binary (.only Parser)]]] + ["[0]" exception (.only exception:)]] [data [collection ["[0]" dictionary (.only Dictionary)]] ["[0]" binary + [\\parser (.only Parser)] ["[1]" \\format (.only Writer)]]] [type (.only sharing) [primitive (.except)]]]] diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux index ffe3b439f..0f15e8ca7 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux @@ -4,15 +4,15 @@ [abstract [monad (.only do)]] [control + ["<>" parser] ["[0]" pipe] ["[0]" maybe (.open: "[1]#[0]" functor)] - ["[0]" exception (.only exception:)] - ["<>" parser (.only) - ["<[0]>" binary (.only Parser)]]] + ["[0]" exception (.only exception:)]] [data ["[0]" product] ["[0]" binary - ["[1]" \\format (.only Writer)]] + ["[1]" \\format (.only Writer)] + ["<[1]>" \\parser (.only Parser)]] ["[0]" text (.only) ["%" \\format (.only format)]] [collection diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/signature.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/signature.lux index c4d347c21..ac6a22c49 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/signature.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/signature.lux @@ -4,12 +4,12 @@ [abstract [equivalence (.only Equivalence)]] [control - ["<>" parser (.only) - ["<[0]>" binary (.only Parser)]]] + ["<>" parser]] [data ["[0]" product] ["[0]" binary - ["[1]" \\format (.only Writer)]] + ["[1]" \\format (.only Writer)] + ["<[1]>" \\parser (.only Parser)]] ["[0]" text (.only) ["%" \\format (.only format)]]] [math diff --git a/stdlib/source/library/lux/tool/compiler/meta/import.lux b/stdlib/source/library/lux/tool/compiler/meta/import.lux index 977d0536c..dec6dde3b 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/import.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/import.lux @@ -4,14 +4,14 @@ [abstract ["[0]" monad (.only Monad do)]] [control + ["<>" parser] ["[0]" try (.only Try)] ["[0]" exception (.only exception:)] [concurrency - ["[0]" async (.only Async)]] - ["<>" parser (.only) - ["<[0]>" binary]]] + ["[0]" async (.only Async)]]] [data - [binary (.only Binary)] + ["[0]" binary (.only Binary) + ["<[1]>" \\parser]] ["[0]" text (.only) ["%" \\format]] [collection diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux index 90afd44d8..a192cf58a 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -5,14 +5,14 @@ [abstract ["[0]" monad (.only Monad do)]] [control + ["<>" parser] ["[0]" try (.only Try)] [concurrency - ["[0]" async (.only Async) (.open: "[1]#[0]" monad)]] - ["<>" parser (.only) - ["<[0]>" binary (.only Parser)]]] + ["[0]" async (.only Async) (.open: "[1]#[0]" monad)]]] [data - [binary (.only Binary)] ["[0]" product] + ["[0]" binary (.only Binary) + ["<[1]>" \\parser (.only Parser)]] ["[0]" text (.open: "[1]#[0]" equivalence) ["%" \\format (.only format)]] [collection diff --git a/stdlib/source/library/lux/control/parser/binary.lux b/stdlib/source/parser/lux/data/binary.lux index 98d23b610..1a49d5315 100644 --- a/stdlib/source/library/lux/control/parser/binary.lux +++ b/stdlib/source/parser/lux/data/binary.lux @@ -7,6 +7,7 @@ [hash (.only Hash)] [monad (.only do)]] [control + ["//" parser (.open: "[1]#[0]" monad)] ["[0]" try (.only Try)] ["[0]" exception (.only exception:)]] [data @@ -28,8 +29,7 @@ [math [number ["n" nat] - ["[0]" frac]]]]] - ["[0]" // (.open: "[1]#[0]" monad)]) + ["[0]" frac]]]]]) (type: .public Offset Nat) diff --git a/stdlib/source/library/lux/control/parser/synthesis.lux b/stdlib/source/parser/lux/tool/compiler/language/lux/synthesis.lux index 9e73bf80c..c6537531f 100644 --- a/stdlib/source/library/lux/control/parser/synthesis.lux +++ b/stdlib/source/parser/lux/tool/compiler/language/lux/synthesis.lux @@ -4,6 +4,7 @@ [abstract [monad (.only do)]] [control + ["//" parser] ["[0]" try (.only Try)] ["[0]" exception (.only exception:)]] [data @@ -26,9 +27,9 @@ [arity (.only Arity)] [language [lux - [analysis (.only Environment)] - ["/" synthesis (.only Synthesis Abstraction)]]]]]]] - ["[0]" //]) + [analysis (.only Environment)]]]]]]] + [\\library + ["[0]" / (.only Synthesis Abstraction)]]) (exception: .public (cannot_parse [input (List Synthesis)]) (exception.report |