From 46b1f5100b13daa4225ca8a156de7be58f3d8b0a Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 16 Aug 2018 21:39:04 -0400
Subject: Various fixes.
---
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 ++++----
6 files changed, 76 insertions(+), 58 deletions(-)
(limited to 'stdlib')
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