From 46b1f5100b13daa4225ca8a156de7be58f3d8b0a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 16 Aug 2018 21:39:04 -0400 Subject: Various fixes. --- .../lang/translation/jvm/procedure/common.jvm.lux | 60 ++++++++++---------- .../luxc/lang/translation/jvm/reference.jvm.lux | 2 +- stdlib/source/lux.lux | 40 +++++++------- .../default/phase/extension/analysis/common.lux | 2 +- .../lux/compiler/default/phase/synthesis.lux | 64 ++++++++++++++-------- .../compiler/default/phase/synthesis/function.lux | 4 +- .../lux/compiler/default/phase/translation.lux | 2 +- stdlib/source/lux/compiler/default/syntax.lux | 22 ++++---- 8 files changed, 107 insertions(+), 89 deletions(-) diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux index d1826669a..b073aa3b7 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux @@ -149,9 +149,9 @@ Nullary (|>> (_.wrap )))] - [f64::smallest (_.double Double::MIN_VALUE) #$.Double] - [f64::min (_.double (f/* -1.0 Double::MAX_VALUE)) #$.Double] - [f64::max (_.double Double::MAX_VALUE) #$.Double] + [frac::smallest (_.double Double::MIN_VALUE) #$.Double] + [frac::min (_.double (f/* -1.0 Double::MAX_VALUE)) #$.Double] + [frac::max (_.double Double::MAX_VALUE) #$.Double] ) (do-template [ ] @@ -168,11 +168,11 @@ [i64::/ #$.Long _.LDIV] [i64::% #$.Long _.LREM] - [f64::+ #$.Double _.DADD] - [f64::- #$.Double _.DSUB] - [f64::* #$.Double _.DMUL] - [f64::/ #$.Double _.DDIV] - [f64::% #$.Double _.DREM] + [frac::+ #$.Double _.DADD] + [frac::- #$.Double _.DSUB] + [frac::* #$.Double _.DMUL] + [frac::/ #$.Double _.DDIV] + [frac::% #$.Double _.DREM] ) (do-template [ ] @@ -189,7 +189,7 @@ [ -1])] [i64::= i64::< (_.unwrap #$.Long) _.LCMP] - [f64::= f64::< (_.unwrap #$.Double) _.DCMPG] + [frac::= frac::< (_.unwrap #$.Double) _.DCMPG] ) (do-template [ ] @@ -197,14 +197,14 @@ Unary (|>> inputI ))] - [i64::to-f64 (_.unwrap #$.Long) (<| (_.wrap #$.Double) _.L2D)] + [i64::to-frac (_.unwrap #$.Long) (<| (_.wrap #$.Double) _.L2D)] [i64::char (_.unwrap #$.Long) ((|>> _.L2I _.I2C (_.INVOKESTATIC "java.lang.Character" "toString" (_t.method (list _t.char) (#.Some $String) (list)) #0)))] - [f64::to-i64 (_.unwrap #$.Double) (<| (_.wrap #$.Long) _.D2L)] - [f64::encode (_.unwrap #$.Double) + [frac::to-i64 (_.unwrap #$.Double) (<| (_.wrap #$.Long) _.D2L)] + [frac::encode (_.unwrap #$.Double) (_.INVOKESTATIC "java.lang.Double" "toString" (_t.method (list _t.double) (#.Some $String) (list)) #0)] - [f64::decode ..check-stringI + [frac::decode ..check-stringI (_.INVOKESTATIC ///.runtime-class "decode_frac" (_t.method (list $String) (#.Some $Object-Array) (list)) #0)] ) @@ -329,26 +329,26 @@ (bundle.install "/" (binary i64::/)) (bundle.install "%" (binary i64::%)) (bundle.install "<" (binary i64::<)) - (bundle.install "to-f64" (unary i64::to-f64)) + (bundle.install "to-frac" (unary i64::to-frac)) (bundle.install "char" (unary i64::char))))) -(def: bundle::f64 +(def: bundle::frac Bundle - (<| (bundle.prefix "f64") + (<| (bundle.prefix "frac") (|> (: Bundle bundle.empty) - (bundle.install "+" (binary f64::+)) - (bundle.install "-" (binary f64::-)) - (bundle.install "*" (binary f64::*)) - (bundle.install "/" (binary f64::/)) - (bundle.install "%" (binary f64::%)) - (bundle.install "=" (binary f64::=)) - (bundle.install "<" (binary f64::<)) - (bundle.install "smallest" (nullary f64::smallest)) - (bundle.install "min" (nullary f64::min)) - (bundle.install "max" (nullary f64::max)) - (bundle.install "to-i64" (unary f64::to-i64)) - (bundle.install "encode" (unary f64::encode)) - (bundle.install "decode" (unary f64::decode))))) + (bundle.install "+" (binary frac::+)) + (bundle.install "-" (binary frac::-)) + (bundle.install "*" (binary frac::*)) + (bundle.install "/" (binary frac::/)) + (bundle.install "%" (binary frac::%)) + (bundle.install "=" (binary frac::=)) + (bundle.install "<" (binary frac::<)) + (bundle.install "smallest" (nullary frac::smallest)) + (bundle.install "min" (nullary frac::min)) + (bundle.install "max" (nullary frac::max)) + (bundle.install "to-i64" (unary frac::to-i64)) + (bundle.install "encode" (unary frac::encode)) + (bundle.install "decode" (unary frac::decode))))) (def: bundle::text Bundle @@ -377,6 +377,6 @@ (|> bundle::lux (dictionary.merge bundle::i64) (dictionary.merge bundle::int) - (dictionary.merge bundle::f64) + (dictionary.merge bundle::frac) (dictionary.merge bundle::text) (dictionary.merge bundle::io)))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux index 2268b3ba2..9d1d8134f 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux @@ -22,7 +22,7 @@ (do-template [ ] [(def: #export ( idx) (-> Nat Text) - (|> idx .int %i (format )))] + (|> idx %n (format )))] [foreign-name "f"] [partial-name "p"] 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 @@ -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 @@ -5230,19 +5230,19 @@ (def: (doc-example->Text prev-cursor baseline example) (-> Cursor Nat Code [Cursor Text]) (case example - (^template [ ] + (^template [ ] [new-cursor ( value)] - (let [as-text ( value)] + (let [as-text ( 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 [ ] [group-cursor ( parts)] @@ -5492,7 +5492,7 @@ (with-expansions [ (do-template [ ] [(compare ) - (compare (:: Code/encode show )) + (compare (:: Code/encode encode )) (compare #1 (:: Equivalence = ))] [(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 [ ] - (^ ( value)) - ( 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 [ ] + ( value) + ( 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 ( 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 [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? -- cgit v1.2.3