diff options
Diffstat (limited to 'stdlib')
6 files changed, 76 insertions, 58 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index e5a992052..48540c114 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -4443,7 +4443,7 @@ _ (list))) -(def: (type/show type) +(def: (type/encode type) (-> Type Text) (case type (#Primitive name params) @@ -4452,16 +4452,16 @@ name _ - ($_ text/compose "(" name " " (|> params (list/map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")")) + ($_ text/compose "(" name " " (|> params (list/map type/encode) (interpose " ") list/reverse (list/fold text/compose "")) ")")) (#Sum _) - ($_ text/compose "(| " (|> (flatten-variant type) (list/map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")") + ($_ text/compose "(| " (|> (flatten-variant type) (list/map type/encode) (interpose " ") list/reverse (list/fold text/compose "")) ")") (#Product _) - ($_ text/compose "[" (|> (flatten-tuple type) (list/map type/show) (interpose " ") list/reverse (list/fold text/compose "")) "]") + ($_ text/compose "[" (|> (flatten-tuple type) (list/map type/encode) (interpose " ") list/reverse (list/fold text/compose "")) "]") (#Function _) - ($_ text/compose "(-> " (|> (flatten-lambda type) (list/map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")") + ($_ text/compose "(-> " (|> (flatten-lambda type) (list/map type/encode) (interpose " ") list/reverse (list/fold text/compose "")) ")") (#Parameter id) (nat/encode id) @@ -4473,16 +4473,16 @@ ($_ text/compose "⟨e:" (nat/encode id) "⟩") (#UnivQ env body) - ($_ text/compose "(All " (type/show body) ")") + ($_ text/compose "(All " (type/encode body) ")") (#ExQ env body) - ($_ text/compose "(Ex " (type/show body) ")") + ($_ text/compose "(Ex " (type/encode body) ")") (#Apply _) (let [[func args] (flatten-app type)] ($_ text/compose - "(" (type/show func) " " - (|> args (list/map type/show) (interpose " ") list/reverse (list/fold text/compose "")) + "(" (type/encode func) " " + (|> args (list/map type/encode) (interpose " ") list/reverse (list/fold text/compose "")) ")")) (#Named [prefix name] _) @@ -4507,7 +4507,7 @@ struct-evidence (resolve-type-tags init-type)] (case struct-evidence #None - (fail (text/compose "Can only \"open\" structs: " (type/show init-type))) + (fail (text/compose "Can only \"open\" structs: " (type/encode init-type))) (#Some tags&members) (do Monad<Meta> @@ -4667,7 +4667,7 @@ (return (list/join decls'))) _ - (fail (text/compose "Can only \"open:\" structs: " (type/show struct-type))))) + (fail (text/compose "Can only \"open:\" structs: " (type/encode struct-type))))) _ (do Monad<Meta> @@ -5230,19 +5230,19 @@ (def: (doc-example->Text prev-cursor baseline example) (-> Cursor Nat Code [Cursor Text]) (case example - (^template [<tag> <show>] + (^template [<tag> <encode>] [new-cursor (<tag> value)] - (let [as-text (<show> value)] + (let [as-text (<encode> value)] [(update-cursor new-cursor as-text) (text/compose (cursor-padding baseline prev-cursor new-cursor) as-text)])) - ([#Bit bit/encode] - [#Nat nat/encode] - [#Int int/encode] - [#Frac frac/encode] - [#Text text/encode] + ([#Bit bit/encode] + [#Nat nat/encode] + [#Int int/encode] + [#Frac frac/encode] + [#Text text/encode] [#Identifier name/encode] - [#Tag tag/encode]) + [#Tag tag/encode]) (^template [<tag> <open> <close> <prep>] [group-cursor (<tag> parts)] @@ -5492,7 +5492,7 @@ (with-expansions [<tests> (do-template [<expr> <text> <pattern>] [(compare <pattern> <expr>) - (compare <text> (:: Code/encode show <expr>)) + (compare <text> (:: Code/encode encode <expr>)) (compare #1 (:: Equivalence<Code> = <expr> <expr>))] [(bit #1) "#1" [_ (#.Bit #1)]] diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux index 884ef7302..a55e7b2b5 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux @@ -170,7 +170,7 @@ (bundle.install "*" (binary Int Int Int)) (bundle.install "/" (binary Int Int Int)) (bundle.install "%" (binary Int Int Int)) - (bundle.install "<" (binary Int Int Int)) + (bundle.install "<" (binary Int Int Bit)) (bundle.install "to-frac" (unary Int Frac)) (bundle.install "char" (unary Int Text))))) diff --git a/stdlib/source/lux/compiler/default/phase/synthesis.lux b/stdlib/source/lux/compiler/default/phase/synthesis.lux index da5cad094..cf29ad74b 100644 --- a/stdlib/source/lux/compiler/default/phase/synthesis.lux +++ b/stdlib/source/lux/compiler/default/phase/synthesis.lux @@ -310,29 +310,35 @@ (def: #export (%synthesis value) (Format Synthesis) (case value - (^template [<pattern> <format>] - (^ (<pattern> value)) - (<format> value)) - ([..bit %b] - [..f64 %f] - [..text %t]) - - (^ (..i64 value)) - (%i (.int value)) - - (^ (..variant [lefts right? content])) - (|> (%synthesis content) - (format (%n lefts) " " (%b right?) " ") - (text.enclose ["(" ")"])) - - (^ (..tuple members)) - (|> members - (list/map %synthesis) - (text.join-with " ") - (text.enclose ["[" "]"])) + (#Primitive primitive) + (case primitive + (^template [<pattern> <format>] + (<pattern> value) + (<format> value)) + ([#Bit %b] + [#F64 %f] + [#Text %t]) + + (#I64 value) + (%i (.int value))) + + (#Structure structure) + (case structure + (#analysis.Variant [lefts right? content]) + (|> (%synthesis content) + (format (%n lefts) " " (%b right?) " ") + (text.enclose ["(" ")"])) + + (#analysis.Tuple members) + (|> members + (list/map %synthesis) + (text.join-with " ") + (text.enclose ["[" "]"]))) (#Reference reference) - (reference.%reference reference) + (|> reference + reference.%reference + (text.enclose ["(#@ " ")"])) (#Control control) (case control @@ -354,8 +360,20 @@ (format (%synthesis func) " ") (text.enclose ["(" ")"]))) - ## (%path' %synthesis ...) - ## (#Branch branch) + (#Branch branch) + (case branch + (#Let input register body) + (|> (format (%synthesis input) " " (%n register) " " (%synthesis body)) + (text.enclose ["(#let " ")"])) + + (#If test then else) + (|> (format (%synthesis test) " " (%synthesis then) " " (%synthesis else)) + (text.enclose ["(#if " ")"])) + + (#Case input path) + (|> (format (%synthesis input) " " (%path' %synthesis path)) + (text.enclose ["(#case " ")"]))) + ## (#Loop loop) _ "???") diff --git a/stdlib/source/lux/compiler/default/phase/synthesis/function.lux b/stdlib/source/lux/compiler/default/phase/synthesis/function.lux index 196d959ed..267d941fc 100644 --- a/stdlib/source/lux/compiler/default/phase/synthesis/function.lux +++ b/stdlib/source/lux/compiler/default/phase/synthesis/function.lux @@ -79,7 +79,7 @@ [left' (grow-path grow left) right' (grow-path grow right)] (wrap (<tag> left' right')))) - ([#//.Alt] [#//.Alt]) + ([#//.Alt] [#//.Seq]) (#//.Then thenS) (|> thenS @@ -95,7 +95,7 @@ (function (_ variable) (case variable (#reference.Local register) - (operation/wrap variable) + (operation/wrap (#reference.Local (inc register))) (#reference.Foreign register) (find-foreign super register))) diff --git a/stdlib/source/lux/compiler/default/phase/translation.lux b/stdlib/source/lux/compiler/default/phase/translation.lux index 1dcd351c8..b1a224e80 100644 --- a/stdlib/source/lux/compiler/default/phase/translation.lux +++ b/stdlib/source/lux/compiler/default/phase/translation.lux @@ -102,7 +102,7 @@ (Operation anchor expression statement [Text output]))) (function (_ [bundle state]) (let [[old-scope old-inner] (get@ #context state) - new-scope (format old-scope "c___" (%i (.int old-inner)))] + new-scope (format old-scope "c" (%n old-inner))] (case (expr [bundle (set@ #context [new-scope 0] state)]) (#error.Success [[bundle' state'] output]) (#error.Success [[bundle' (set@ #context [old-scope (inc old-inner)] state')] diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index 09db624df..7556e7e46 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -609,17 +609,17 @@ (do p.Monad<Parser> [where (left-padding^ where)] ($_ p.either - (form where ast') - (tuple where ast') - (record where ast') - (identifier current-module aliases where) - (tag current-module aliases where) - (text where) - (nat where) - (int where) - (frac where) - (rev where) - (bit where) + (..form where ast') + (..tuple where ast') + (..record where ast') + (..text where) + (..nat where) + (..int where) + (..frac where) + (..rev where) + (..bit where) + (..identifier current-module aliases where) + (..tag current-module aliases where) (do @ [end? l.end?] (if end? |