From 0f9f87286acacb520aa3ab0252131e109184b4cb Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 13 Jan 2023 22:11:05 -0400
Subject: Better formatting for types & symbols for compilation logging.

---
 stdlib/source/library/lux/data/format/xml.lux      |   2 +-
 stdlib/source/library/lux/ffi.old.lux              |   4 +-
 .../library/lux/math/arithmetic/fixed_point.lux    |   1 +
 stdlib/source/library/lux/meta.lux                 | 118 ++++++++++++++-------
 stdlib/source/library/lux/meta/code.lux            |   2 +-
 .../language/lux/phase/analysis/complex.lux        |   6 +-
 .../lux/phase/extension/declaration/lux.lux        |  11 +-
 .../language/lux/phase/translation/jvm.lux         |   6 +-
 .../language/lux/phase/translation/jvm/complex.lux | 102 ++++++++++++++++++
 .../lux/phase/translation/jvm/primitive.lux        |   4 +-
 .../lux/phase/translation/jvm/structure.lux        | 100 -----------------
 .../language/lux/phase/translation/jvm/when.lux    |   6 +-
 .../language/lux/phase/translation/python.lux      |   5 +-
 .../lux/meta/compiler/target/jvm/bytecode.lux      |  18 ++--
 stdlib/source/library/lux/meta/macro.lux           |   2 +-
 stdlib/source/library/lux/meta/macro/context.lux   |   2 +-
 stdlib/source/library/lux/meta/macro/expansion.lux |   2 +-
 .../source/library/lux/meta/macro/vocabulary.lux   |   4 +-
 stdlib/source/library/lux/meta/symbol.lux          |   4 +-
 stdlib/source/library/lux/meta/type.lux            | 102 ++++++++++++------
 stdlib/source/library/lux/meta/type/check.lux      |  12 +--
 stdlib/source/library/lux/meta/type/nominal.lux    |   2 +-
 22 files changed, 299 insertions(+), 216 deletions(-)
 create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/complex.lux
 delete mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/structure.lux

(limited to 'stdlib/source/library')

diff --git a/stdlib/source/library/lux/data/format/xml.lux b/stdlib/source/library/lux/data/format/xml.lux
index 3a63629a9..b704a4cfc 100644
--- a/stdlib/source/library/lux/data/format/xml.lux
+++ b/stdlib/source/library/lux/data/format/xml.lux
@@ -23,7 +23,7 @@
      ["n" nat]
      ["[0]" int]]]
    [meta
-    ["[0]" symbol (.use "[1]#[0]" equivalence codec)]]]])
+    ["[0]" symbol (.use "[1]#[0]" equivalence absolute)]]]])
 
 (type .public Tag
   Symbol)
diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux
index fa6dea601..7fec7dba4 100644
--- a/stdlib/source/library/lux/ffi.old.lux
+++ b/stdlib/source/library/lux/ffi.old.lux
@@ -1679,7 +1679,7 @@
       {.#Apply A F}
       (when (type.applied (list A) F)
         {.#None}
-        (meta.failure (format "Cannot apply type: " (type.format F) " to " (type.format A)))
+        (meta.failure (format "Cannot apply type: " (%.type F) " to " (%.type A)))
 
         {.#Some type'}
         (type_class_name type'))
@@ -1688,7 +1688,7 @@
       (type_class_name type')
 
       _
-      (meta.failure (format "Cannot convert to JvmType: " (type.format type))))))
+      (meta.failure (format "Cannot convert to JvmType: " (%.type type))))))
 
 (def .public read!
   (syntax (_ [idx <code>.any
diff --git a/stdlib/source/library/lux/math/arithmetic/fixed_point.lux b/stdlib/source/library/lux/math/arithmetic/fixed_point.lux
index e6ac5834b..4498bce85 100644
--- a/stdlib/source/library/lux/math/arithmetic/fixed_point.lux
+++ b/stdlib/source/library/lux/math/arithmetic/fixed_point.lux
@@ -112,6 +112,7 @@
             Rev))
       (|>> nominal.representation
            (i64.and (i64.mask (nominal.representation Point @)))
+           (i64.left_shifted (n.- (nominal.representation Point @) i64.width))
            .rev))
 
     (with_template [<composite_type> <post_processing> <fp> <int>]
diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux
index d581c3a7e..3a45da32d 100644
--- a/stdlib/source/library/lux/meta.lux
+++ b/stdlib/source/library/lux/meta.lux
@@ -23,7 +23,7 @@
      ["i" int]]]]]
  [/
   ["[0]" location]
-  ["[0]" symbol (.use "[1]#[0]" codec equivalence)]
+  ["[0]" symbol (.use "[1]#[0]" absolute equivalence)]
   ["[0]" code]])
 
 ... (.type (Meta a)
@@ -79,11 +79,15 @@
          {try.#Failure msg})))))
 
 (def .public (result' lux action)
-  (All (_ a) (-> Lux (Meta a) (Try [Lux a])))
+  (All (_ of)
+    (-> Lux (Meta of)
+        (Try [Lux of])))
   (action lux))
 
 (def .public (result lux action)
-  (All (_ a) (-> Lux (Meta a) (Try a)))
+  (All (_ of)
+    (-> Lux (Meta of)
+        (Try of)))
   (when (action lux)
     {try.#Success [_ output]}
     {try.#Success output}
@@ -92,7 +96,9 @@
     {try.#Failure error}))
 
 (def .public (either left right)
-  (All (_ a) (-> (Meta a) (Meta a) (Meta a)))
+  (All (_ of)
+    (-> (Meta of) (Meta of)
+        (Meta of)))
   (function (_ lux)
     (when (left lux)
       {try.#Success [lux' output]}
@@ -102,20 +108,23 @@
       (right lux))))
 
 (def .public (assertion message test)
-  (-> Text Bit (Meta Any))
+  (-> Text Bit
+      (Meta Any))
   (function (_ lux)
     (if test
       {try.#Success [lux []]}
       {try.#Failure message})))
 
 (def .public (failure error)
-  (All (_ a)
-    (-> Text (Meta a)))
+  (All (_ of)
+    (-> Text
+        (Meta of)))
   (function (_ state)
     {try.#Failure (location.with (the .#location state) error)}))
 
 (def .public (module name)
-  (-> Text (Meta Module))
+  (-> Text
+      (Meta Module))
   (function (_ lux)
     (when (property.value name (the .#modules lux))
       {.#Some module}
@@ -142,7 +151,8 @@
         /#conjoint)))
 
 (def (macro_type? type)
-  (-> Type Bit)
+  (-> Type
+      Bit)
   (when type
     {.#Named [.prelude "Macro"]
              {.#Nominal "#Macro" {.#End}}}
@@ -152,7 +162,8 @@
     false))
 
 (def .public (normal name)
-  (-> Symbol (Meta Symbol))
+  (-> Symbol
+      (Meta Symbol))
   (when name
     ["" name]
     (do ..monad
@@ -163,7 +174,8 @@
     (of ..monad in name)))
 
 (def .public (macro full_name)
-  (-> Symbol (Meta (Maybe Macro)))
+  (-> Symbol
+      (Meta (Maybe Macro)))
   (do ..monad
     [[module name] (..normal full_name)]
     (is (Meta (Maybe Macro))
@@ -203,7 +215,8 @@
                    (the .#seed lux)]}))
 
 (def .public (module_exists? module)
-  (-> Text (Meta Bit))
+  (-> Text
+      (Meta Bit))
   (function (_ lux)
     {try.#Success [lux (when (property.value module (the .#modules lux))
                          {.#Some _}
@@ -213,14 +226,19 @@
                          false)]}))
 
 (def (on_either f x1 x2)
-  (All (_ a b)
-    (-> (-> a (Maybe b)) a a (Maybe b)))
+  (All (_ input output)
+    (-> (-> input (Maybe output)) input input
+        (Maybe output)))
   (when (f x1)
-    {.#None}   (f x2)
-    {.#Some y} {.#Some y}))
+    {.#None}
+    (f x2)
+    
+    some
+    some))
 
 (def (type_variable idx bindings)
-  (-> Nat (List [Nat (Maybe Type)]) (Maybe Type))
+  (-> Nat (List [Nat (Maybe Type)])
+      (Maybe Type))
   (when bindings
     {.#End}
     {.#None}
@@ -231,7 +249,8 @@
       (type_variable idx bindings'))))
 
 (`` (def (clean_type type)
-      (-> Type (Meta Type))
+      (-> Type
+          (Meta Type))
       (when type
         {.#Var var}
         (function (_ lux)
@@ -253,7 +272,8 @@
         (of ..monad in type))))
 
 (def .public (var_type name)
-  (-> Text (Meta Type))
+  (-> Text
+      (Meta Type))
   (function (_ lux)
     (let [test (is (-> [Text [Type Any]] Bit)
                    (|>> product.left (text#= name)))]
@@ -277,7 +297,8 @@
         {try.#Failure (all text#composite "Unknown variable: " name)}))))
 
 (def without_lux_runtime
-  (-> (List Text) (List Text))
+  (-> (List Text)
+      (List Text))
   ... The Lux runtime shows up as ""
   ... so I'm excluding it.
   (list.only (|>> text.empty? not)))
@@ -287,14 +308,16 @@
   (all text#composite text.new_line "                    "))
 
 (def module_listing
-  (-> (List Text) Text)
+  (-> (List Text)
+      Text)
   (|>> ..without_lux_runtime
        (list.sorted text#<)
        (text.interposed ..listing_separator)))
 
 (with_template [<name> <yes>]
   [(def .public (<name> name)
-     (-> Symbol (Meta [Bit Global]))
+     (-> Symbol
+         (Meta [Bit Global]))
      (do ..monad
        [name (..normal name)
         .let [[normal_module normal_short] name]]
@@ -360,7 +383,8 @@
   )
 
 (def .public (export name)
-  (-> Symbol (Meta Definition))
+  (-> Symbol
+      (Meta Definition))
   (do [! ..monad]
     [name (..normal name)
      .let [[expected _] name]
@@ -385,7 +409,8 @@
                     (symbol#encoded name))))))
 
 (def .public (default name)
-  (-> Symbol (Meta Default))
+  (-> Symbol
+      (Meta Default))
   (do [! ..monad]
     [name (..normal name)
      [exported? definition] (..default' name)]
@@ -439,7 +464,8 @@
   )
 
 (def .public (definition_type name)
-  (-> Symbol (Meta Type))
+  (-> Symbol
+      (Meta Type))
   (do ..monad
     [[exported? definition] (definition name)]
     (when definition
@@ -455,7 +481,8 @@
                     (symbol#encoded name))))))
 
 (def .public (type name)
-  (-> Symbol (Meta Type))
+  (-> Symbol
+      (Meta Type))
   (when name
     ["" _name]
     (either (var_type _name)
@@ -465,7 +492,8 @@
     (definition_type name)))
 
 (def .public (type_definition name)
-  (-> Symbol (Meta Type))
+  (-> Symbol
+      (Meta Type))
   (do ..monad
     [[exported? definition] (definition name)]
     (when definition
@@ -485,7 +513,8 @@
       (..failure (all text#composite "Default is not a type: " (symbol#encoded name))))))
 
 (def .public (globals module)
-  (-> Text (Meta (List [Text [Bit Global]])))
+  (-> Text
+      (Meta (List [Text [Bit Global]])))
   (function (_ lux)
     (when (property.value module (the .#modules lux))
       {.#Some module}
@@ -495,7 +524,8 @@
       {try.#Failure (all text#composite "Unknown module: " module)})))
 
 (def .public (definitions module)
-  (-> Text (Meta (List [Text [Bit Definition]])))
+  (-> Text
+      (Meta (List [Text [Bit Definition]])))
   (of ..monad each
       (list.all (function (_ [name [exported? global]])
                   (when global
@@ -510,7 +540,8 @@
       (..globals module)))
 
 (def .public (resolved_globals module)
-  (-> Text (Meta (List [Text [Bit Definition]])))
+  (-> Text
+      (Meta (List [Text [Bit Definition]])))
   (do [! ..monad]
     [it (..globals module)
      .let [input (is (List [Text Bit (Either Symbol Definition)])
@@ -563,7 +594,8 @@
               {try.#Failure error})))))))
 
 (def .public (exports module_name)
-  (-> Text (Meta (List [Text Definition])))
+  (-> Text
+      (Meta (List [Text Definition])))
   (do ..monad
     [constants (..definitions module_name)]
     (in (do list.monad
@@ -587,7 +619,8 @@
   (`` (.in_module# (,, (static .prelude)) .type#encoded)))
 
 (def .public (tags_of type_name)
-  (-> Symbol (Meta (Maybe (List Symbol))))
+  (-> Symbol
+      (Meta (Maybe (List Symbol))))
   (do ..monad
     [.let [[module_name name] type_name]
      module (..module module_name)]
@@ -631,26 +664,30 @@
       {try.#Failure "Not expecting any type."})))
 
 (def .public (imported_modules module_name)
-  (-> Text (Meta (List Text)))
+  (-> Text
+      (Meta (List Text)))
   (do ..monad
     [(open "_[0]") (..module module_name)]
     (in _#imports)))
 
 (def .public (imported_by? import module)
-  (-> Text Text (Meta Bit))
+  (-> Text Text
+      (Meta Bit))
   (do ..monad
     [(open "_[0]") (..module module)]
     (in (list.any? (text#= import) _#imports))))
 
 (def .public (imported? import)
-  (-> Text (Meta Bit))
+  (-> Text
+      (Meta Bit))
   (of ..functor each
       (|>> (the .#imports) (list.any? (text#= import)))
       ..current_module))
 
 (with_template [<name> <description> <type>]
   [(def .public (<name> label_name)
-     (-> Symbol (Meta Label))
+     (-> Symbol
+         (Meta Label))
      (do ..monad
        [.let [[module name] label_name]
         =module (..module module)
@@ -673,7 +710,8 @@
   )
 
 (def .public (tag_lists module)
-  (-> Text (Meta (List [(List Symbol) Type])))
+  (-> Text
+      (Meta (List [(List Symbol) Type])))
   (do ..monad
     [=module (..module module)
      this_module_name ..current_module_name]
@@ -719,7 +757,8 @@
       {try.#Failure "No local environment"})))
 
 (def .public (de_aliased def_name)
-  (-> Symbol (Meta Symbol))
+  (-> Symbol
+      (Meta Symbol))
   (do ..monad
     [[exported? constant] (..definition def_name)]
     (in (when constant
@@ -744,7 +783,8 @@
     (..failure error)))
 
 (def .public (eval type code)
-  (-> Type Code (Meta Any))
+  (-> Type Code
+      (Meta Any))
   (do [! ..monad]
     [eval (of ! each (the .#eval)
               ..compiler_state)]
diff --git a/stdlib/source/library/lux/meta/code.lux b/stdlib/source/library/lux/meta/code.lux
index 480ea56c9..9065e8232 100644
--- a/stdlib/source/library/lux/meta/code.lux
+++ b/stdlib/source/library/lux/meta/code.lux
@@ -101,7 +101,7 @@
               [.#Int    int.decimal]
               [.#Rev    rev.decimal]
               [.#Frac   frac.decimal]
-              [.#Symbol symbol.codec]))
+              [.#Symbol symbol.absolute]))
 
         [_ {.#Text value}]
         (text.format value)
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux
index d71d0b0c6..acb4a676e 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux
@@ -1,10 +1,10 @@
+... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/.
+
 (.require
  [library
   [lux (.except Tag Analysis)
    [abstract
-... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
-... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/.
-
     ["[0]" monad (.only do)]]
    [control
     ["[0]" maybe]
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux
index 2fffba00c..1a8b75275 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux
@@ -16,7 +16,7 @@
     ["[0]" binary]
     ["[0]" product]
     ["[0]" text
-     ["%" \\format (.only format)]]
+     ["%" \\format]]
     [collection
      ["[0]" dictionary]
      ["[0]" array]
@@ -192,11 +192,12 @@
           (in [])))]
     (in [])))
 
-(def (announce_definition! short type)
+(def (announce_definition! module short type)
   (All (_ anchor expression declaration)
-    (-> Text Type (Operation anchor expression declaration Any)))
+    (-> Text Text Type
+        (Operation anchor expression declaration Any)))
   (/////declaration.of_translation
-   (/////translation.log! (format short " : " (%.type type)))))
+   (/////translation.log! (%.format short " : " (type.relative_format module type)))))
 
 (def lux::def
   Handler
@@ -233,7 +234,7 @@
            [_ _ exported?] (evaluate! archive Bit exported?C)
            _ (/////declaration.of_analysis
               (moduleA.define short_name [(as Bit exported?) {.#Definition [type value]}]))
-           _ (..announce_definition! short_name type)]
+           _ (..announce_definition! current_module short_name type)]
           (in /////declaration.no_requirements))))]))
 
 (def imports
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm.lux
index 4ddfd3fd4..15a4a8057 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm.lux
@@ -29,7 +29,7 @@
  ["[0]" /
   [runtime (.only Operation Phase Handler)]
   ["[1][0]" primitive]
-  ["[1][0]" structure]
+  ["[1][0]" complex]
   ["[1][0]" reference]
   ["[1][0]" function]
   ["[1][0]" when]
@@ -73,11 +73,11 @@
 
       (synthesis.variant @ variantS)
       (with_source_mapping @
-        (/structure.variant phase archive variantS))
+        (/complex.variant phase archive variantS))
 
       (synthesis.tuple @ members)
       (with_source_mapping @
-        (/structure.tuple phase archive members))
+        (/complex.tuple phase archive members))
 
       [@ {synthesis.#Reference reference}]
       (with_source_mapping @
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/complex.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/complex.lux
new file mode 100644
index 000000000..a449ffa45
--- /dev/null
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/complex.lux
@@ -0,0 +1,102 @@
+... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/.
+
+(.require
+ [library
+  [lux (.except Variant Tuple Synthesis)
+   [abstract
+    ["[0]" monad (.only do)]]
+   [control
+    ["[0]" try]]
+   [data
+    [collection
+     ["[0]" list]]]
+   [math
+    [number
+     ["[0]" i32]]]
+   [meta
+    [compiler
+     [target
+      [jvm
+       ["_" bytecode (.only Bytecode)]
+       ["[0]" type]
+       [encoding
+        ["[0]" signed]]]]]]]]
+ ["[0]" //
+  ["[1][0]" type]
+  ["[1][0]" runtime (.only Operation Phase Translator)]
+  ["[1][0]" primitive]
+  ["///[1]" ////
+   ["[0]" phase]
+   ["[1][0]" synthesis (.only Synthesis)]
+   [analysis
+    [complex (.only Variant Tuple)]]]])
+
+(def .public (lefts lefts)
+  (-> Nat
+      (Bytecode Any))
+  (when lefts
+    0 _.iconst_0
+    1 _.iconst_1
+    2 _.iconst_2
+    3 _.iconst_3
+    4 _.iconst_4
+    5 _.iconst_5
+    _ (when (signed.s1 (.int lefts))
+        {try.#Success value}
+        (_.bipush value)
+
+        {try.#Failure _}
+        (when (signed.s2 (.int lefts))
+          {try.#Success value}
+          (_.sipush value)
+
+          {try.#Failure _}
+          (_.int (.i64 lefts))))))
+
+(def .public (right? right?)
+  (-> Bit
+      (Bytecode Any))
+  (if right?
+    //runtime.right_right?
+    //runtime.left_right?))
+
+(def .public (variant phase archive [lefts right? valueS])
+  (Translator (Variant Synthesis))
+  (do phase.monad
+    [valueI (phase archive valueS)]
+    (in (do _.monad
+          [_ (..lefts lefts)
+           _ (..right? right?)
+           _ valueI]
+          (_.invokestatic //runtime.class "variant"
+                          (type.method [(list)
+                                        (list //type.lefts //type.right? //type.value)
+                                        //type.variant
+                                        (list)]))))))
+
+(def .public (tuple phase archive membersS)
+  (Translator (Tuple Synthesis))
+  (when membersS
+    {.#End}
+    (of phase.monad in //runtime.unit)
+
+    {.#Item singletonS {.#End}}
+    (phase archive singletonS)
+
+    _
+    (do [! phase.monad]
+      [membersI (|> membersS
+                    list.enumeration
+                    (monad.each ! (function (_ [idx member])
+                                    (do !
+                                      [memberI (phase archive member)]
+                                      (in (do _.monad
+                                            [_ _.dup
+                                             _ (_.int (.i64 idx))
+                                             _ memberI]
+                                            _.aastore))))))]
+      (in (do [! _.monad]
+            [_ (_.int (.i64 (list.size membersS)))
+             _ (_.anewarray //type.value)]
+            (monad.all ! membersI))))))
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux
index 86ffa8239..fdcf78041 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux
@@ -137,10 +137,12 @@
                             ..double_bits
                             (i.= ..d0_bits))
                       _.dconst_0
-                      (_.double (as java/lang/Double value)))]
+                      (_.double value))]
       (do _.monad
         [_ constantI]
         ..wrap_f64))))
 
 (def .public text
+  (-> Text
+      (Bytecode Any))
   _.string)
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/structure.lux
deleted file mode 100644
index b06724932..000000000
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/structure.lux
+++ /dev/null
@@ -1,100 +0,0 @@
-... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
-... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/.
-
-(.require
- [library
-  [lux (.except Variant Tuple Synthesis)
-   [abstract
-    ["[0]" monad (.only do)]]
-   [control
-    ["[0]" try]]
-   [data
-    [collection
-     ["[0]" list]]]
-   [math
-    [number
-     ["[0]" i32]]]
-   [meta
-    [compiler
-     [target
-      [jvm
-       ["_" bytecode (.only Bytecode)]
-       ["[0]" type]
-       [encoding
-        ["[0]" signed]]]]]]]]
- ["[0]" //
-  ["[1][0]" type]
-  ["[1][0]" runtime (.only Operation Phase Translator)]
-  ["[1][0]" primitive]
-  ["///[1]" ////
-   ["[0]" phase]
-   ["[1][0]" synthesis (.only Synthesis)]
-   [analysis
-    [complex (.only Variant Tuple)]]]])
-
-(def .public (tuple phase archive membersS)
-  (Translator (Tuple Synthesis))
-  (when membersS
-    {.#End}
-    (of phase.monad in //runtime.unit)
-
-    {.#Item singletonS {.#End}}
-    (phase archive singletonS)
-
-    _
-    (do [! phase.monad]
-      [membersI (|> membersS
-                    list.enumeration
-                    (monad.each ! (function (_ [idx member])
-                                    (do !
-                                      [memberI (phase archive member)]
-                                      (in (do _.monad
-                                            [_ _.dup
-                                             _ (_.int (.i64 idx))
-                                             _ memberI]
-                                            _.aastore))))))]
-      (in (do [! _.monad]
-            [_ (_.int (.i64 (list.size membersS)))
-             _ (_.anewarray //type.value)]
-            (monad.all ! membersI))))))
-
-(def .public (lefts lefts)
-  (-> Nat (Bytecode Any))
-  (when lefts
-    0 _.iconst_0
-    1 _.iconst_1
-    2 _.iconst_2
-    3 _.iconst_3
-    4 _.iconst_4
-    5 _.iconst_5
-    _ (when (signed.s1 (.int lefts))
-        {try.#Success value}
-        (_.bipush value)
-
-        {try.#Failure _}
-        (when (signed.s2 (.int lefts))
-          {try.#Success value}
-          (_.sipush value)
-
-          {try.#Failure _}
-          (_.int (.i64 lefts))))))
-
-(def .public (right? right?)
-  (-> Bit (Bytecode Any))
-  (if right?
-    //runtime.right_right?
-    //runtime.left_right?))
-
-(def .public (variant phase archive [lefts right? valueS])
-  (Translator (Variant Synthesis))
-  (do phase.monad
-    [valueI (phase archive valueS)]
-    (in (do _.monad
-          [_ (..lefts lefts)
-           _ (..right? right?)
-           _ valueI]
-          (_.invokestatic //runtime.class "variant"
-                          (type.method [(list)
-                                        (list //type.lefts //type.right? //type.value)
-                                        //type.variant
-                                        (list)]))))))
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux
index c2d2536b4..558353ad8 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux
@@ -33,7 +33,7 @@
   ["[1][0]" type]
   ["[1][0]" runtime (.only Operation Phase Translator)]
   ["[1][0]" value]
-  ["[1][0]" structure]
+  ["[1][0]" complex]
   [////
    ["[0]" phase (.use "operation#[0]" monad)]
    ["[0]" translation]
@@ -195,8 +195,8 @@
          (all _.composite
               ..peek
               (_.checkcast //type.variant)
-              (//structure.lefts lefts)
-              (//structure.right? right?)
+              (//complex.lefts lefts)
+              (//complex.right? right?)
               //runtime.when
               _.dup
               (_.ifnonnull @success)
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python.lux
index 355b45be8..389716606 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python.lux
@@ -11,8 +11,9 @@
    [meta
     [macro
      ["^" pattern]]
-    [target
-     ["_" python]]]]]
+    [compiler
+     [target
+      ["_" python]]]]]]
  ["[0]" /
   [runtime (.only Phase)]
   ["[1][0]" primitive]
diff --git a/stdlib/source/library/lux/meta/compiler/target/jvm/bytecode.lux b/stdlib/source/library/lux/meta/compiler/target/jvm/bytecode.lux
index 20d7be577..abaf5e2c9 100644
--- a/stdlib/source/library/lux/meta/compiler/target/jvm/bytecode.lux
+++ b/stdlib/source/library/lux/meta/compiler/target/jvm/bytecode.lux
@@ -631,7 +631,10 @@
        (as Int)))
 
 (def negative_zero_float_bits
-  (|> -0.0 (as java/lang/Double) ffi.double_to_float ..float_bits))
+  (|> -0.0
+      (as java/lang/Double)
+      ffi.double_to_float
+      ..float_bits))
 
 (def .public (float value)
   (-> java/lang/Float (Bytecode Any))
@@ -666,21 +669,22 @@
   )
 
 (def (arbitrary_double value)
-  (-> java/lang/Double (Bytecode Any))
+  (-> Frac (Bytecode Any))
   (do ..monad
-    [index (..lifted (//constant/pool.double (//constant.double (as Frac value))))]
+    [index (..lifted (//constant/pool.double (//constant.double value)))]
     (..bytecode $0 $2 @_ _.ldc2_w/double [index])))
 
 (def double_bits
-  (-> java/lang/Double Int)
-  (|>> java/lang/Double::doubleToRawLongBits
+  (-> Frac Int)
+  (|>> (as java/lang/Double)
+       java/lang/Double::doubleToRawLongBits
        (as Int)))
 
 (def negative_zero_double_bits
-  (..double_bits (as java/lang/Double -0.0)))
+  (..double_bits -0.0))
 
 (def .public (double value)
-  (-> java/lang/Double (Bytecode Any))
+  (-> Frac (Bytecode Any))
   (if (i.= ..negative_zero_double_bits
            (..double_bits value))
     (..arbitrary_double value)
diff --git a/stdlib/source/library/lux/meta/macro.lux b/stdlib/source/library/lux/meta/macro.lux
index ee01882f1..4cf514b07 100644
--- a/stdlib/source/library/lux/meta/macro.lux
+++ b/stdlib/source/library/lux/meta/macro.lux
@@ -17,7 +17,7 @@
   ["[1][0]" expansion]]
  ["[0]" // (.only)
   ["[0]" code]
-  ["[0]" symbol (.use "[1]#[0]" codec)]])
+  ["[0]" symbol (.use "[1]#[0]" absolute)]])
 
 (def .public (symbol prefix)
   (-> Text (Meta Code))
diff --git a/stdlib/source/library/lux/meta/macro/context.lux b/stdlib/source/library/lux/meta/macro/context.lux
index 1afd92690..2ed4963c1 100644
--- a/stdlib/source/library/lux/meta/macro/context.lux
+++ b/stdlib/source/library/lux/meta/macro/context.lux
@@ -20,7 +20,7 @@
       ["[0]" property]]]]
    ["[0]" meta (.only)
     [type (.only sharing by_example)]
-    ["[0]" symbol (.use "[1]#[0]" codec)]
+    ["[0]" symbol (.use "[1]#[0]" absolute)]
     ["[0]" code (.only)
      ["?[1]" \\parser]]]]]
  ["[0]" // (.only)
diff --git a/stdlib/source/library/lux/meta/macro/expansion.lux b/stdlib/source/library/lux/meta/macro/expansion.lux
index d7171c0e3..936234ed1 100644
--- a/stdlib/source/library/lux/meta/macro/expansion.lux
+++ b/stdlib/source/library/lux/meta/macro/expansion.lux
@@ -13,7 +13,7 @@
  ["[0]" /// (.only)
   ["[0]" code]
   ["[0]" location]
-  ["[0]" symbol (.use "[1]#[0]" codec)]])
+  ["[0]" symbol (.use "[1]#[0]" absolute)]])
 
 (def wrong_syntax_error
   (-> Symbol Text)
diff --git a/stdlib/source/library/lux/meta/macro/vocabulary.lux b/stdlib/source/library/lux/meta/macro/vocabulary.lux
index 2d236372c..48ae4bff6 100644
--- a/stdlib/source/library/lux/meta/macro/vocabulary.lux
+++ b/stdlib/source/library/lux/meta/macro/vocabulary.lux
@@ -23,8 +23,8 @@
 (exception.def .public (invalid_type [expected actual])
   (Exception [Type Type])
   (exception.report
-   (list ["Expected" (type.format expected)]
-         ["Actual" (type.format actual)])))
+   (list ["Expected" (type.absolute_format expected)]
+         ["Actual" (type.absolute_format actual)])))
 
 (.def local
   (Parser [Code Code])
diff --git a/stdlib/source/library/lux/meta/symbol.lux b/stdlib/source/library/lux/meta/symbol.lux
index 3e8fbf768..b6436066c 100644
--- a/stdlib/source/library/lux/meta/symbol.lux
+++ b/stdlib/source/library/lux/meta/symbol.lux
@@ -46,7 +46,7 @@
 (def .public separator
   ".")
 
-(def .public codec
+(def .public absolute
   (Codec Text Symbol)
   (implementation
    (def (encoded [module short])
@@ -68,7 +68,7 @@
        _
        {.#Left (text#composite "Invalid format for Symbol: " input)}))))
 
-(def .public (relative_codec expected)
+(def .public (relative expected)
   (-> Text
       (Codec Text Symbol))
   (implementation
diff --git a/stdlib/source/library/lux/meta/type.lux b/stdlib/source/library/lux/meta/type.lux
index afe41bec4..7952b99d8 100644
--- a/stdlib/source/library/lux/meta/type.lux
+++ b/stdlib/source/library/lux/meta/type.lux
@@ -6,7 +6,8 @@
   [lux (.except function as let)
    [abstract
     [equivalence (.only Equivalence)]
-    [monad (.only Monad do)]]
+    [monad (.only Monad do)]
+    [codec (.only Codec)]]
    [control
     ["<>" parser]
     ["[0]" function]
@@ -22,7 +23,7 @@
      ["n" nat (.use "[1]#[0]" decimal)]]]
    ["[0]" meta (.only)
     ["[0]" location]
-    ["[0]" symbol (.use "[1]#[0]" equivalence codec)]
+    ["[0]" symbol (.use "[1]#[0]" equivalence)]
     ["[0]" code (.only)
      ["<[1]>" \\parser (.only Parser)]]
     ["[0]" macro (.only)
@@ -33,7 +34,8 @@
 
 (with_template [<name> <tag>]
   [(def .public (<name> type)
-     (-> Type [Nat Type])
+     (-> Type
+         [Nat Type])
      (loop (again [num_args 0
                    type type])
        (when type
@@ -48,7 +50,8 @@
   )
 
 (def .public (flat_function type)
-  (-> Type [(List Type) Type])
+  (-> Type
+      [(List Type) Type])
   (when type
     {.#Function in out'}
     (.let [[ins out] (flat_function out')]
@@ -58,7 +61,8 @@
     [(list) type]))
 
 (def .public (flat_application type)
-  (-> Type [Type (List Type)])
+  (-> Type
+      [Type (List Type)])
   (when type
     {.#Apply arg func'}
     (.let [[func args] (flat_application func')]
@@ -69,7 +73,8 @@
 
 (with_template [<name> <tag>]
   [(def .public (<name> type)
-     (-> Type (List Type))
+     (-> Type
+         (List Type))
      (when type
        {<tag> left right}
        (list.partial left (<name> right))
@@ -81,15 +86,16 @@
   [flat_tuple   .#Product]
   )
 
-(`` (def .public (format type)
-      (-> Type Text)
+(`` (def (format symbol_codec type)
+      (-> (Codec Text Symbol) Type
+          Text)
       (when type
         {.#Nominal name params}
         (all text#composite
              "(Nominal "
              (text.enclosed' text.double_quote name)
              (|> params
-                 (list#each (|>> format (text#composite " ")))
+                 (list#each (|>> (format symbol_codec) (text#composite " ")))
                  (list#mix (function.flipped text#composite) ""))
              ")")
 
@@ -97,7 +103,7 @@
               [{<tag> _}
                (all text#composite <open>
                     (|> (<flat> type)
-                        (list#each format)
+                        (list#each (format symbol_codec))
                         list.reversed
                         (list.interposed " ")
                         (list#mix text#composite ""))
@@ -110,11 +116,11 @@
         (.let [[ins out] (flat_function type)]
           (all text#composite  "(-> "
                (|> ins
-                   (list#each format)
+                   (list#each (format symbol_codec))
                    list.reversed
                    (list.interposed " ")
                    (list#mix text#composite ""))
-               " " (format out) ")"))
+               " " (format symbol_codec out) ")"))
 
         {.#Parameter idx}
         (n#encoded idx)
@@ -127,22 +133,33 @@
 
         {.#Apply param fun}
         (.let [[type_func type_args] (flat_application type)]
-          (all text#composite  "(" (format type_func) " " (|> type_args (list#each format) list.reversed (list.interposed " ") (list#mix text#composite "")) ")"))
+          (all text#composite  "(" (format symbol_codec type_func) " " (|> type_args (list#each (format symbol_codec)) list.reversed (list.interposed " ") (list#mix text#composite "")) ")"))
 
         (,, (with_template [<tag> <desc>]
               [{<tag> env body}
-               (all text#composite "(" <desc> " {" (|> env (list#each format) (text.interposed " ")) "} " (format body) ")")]
+               (all text#composite "(" <desc> " {" (|> env (list#each (format symbol_codec)) (text.interposed " ")) "} " (format symbol_codec body) ")")]
 
               [.#UnivQ "All"]
               [.#ExQ "Ex"]))
 
         {.#Named name type}
-        (symbol#encoded name)
+        (of symbol_codec encoded name)
         )))
 
+(def .public absolute_format
+  (-> Type
+      Text)
+  (..format symbol.absolute))
+
+(def .public (relative_format module)
+  (-> Text Type
+      Text)
+  (..format (symbol.relative module)))
+
 ... https://en.wikipedia.org/wiki/Lambda_calculus#%CE%B2-reduction
 (`` (def (reduced env type)
-      (-> (List Type) Type Type)
+      (-> (List Type) Type
+          Type)
       (when type
         {.#Nominal name params}
         {.#Nominal name (list#each (reduced env) params)}
@@ -175,7 +192,7 @@
                                                      (list#each (.function (_ [index type])
                                                                   (all text#composite
                                                                        (n#encoded index)
-                                                                       " " (..format type))))
+                                                                       " " (..absolute_format type))))
                                                      (text.interposed (text#composite text.new_line "             ")))))
                     (list.item idx env))
         
@@ -240,7 +257,8 @@
                ))))))
 
 (`` (def .public (applied params func)
-      (-> (List Type) Type (Maybe Type))
+      (-> (List Type) Type
+          (Maybe Type))
       (when params
         {.#End}
         {.#Some func}
@@ -266,7 +284,8 @@
           {.#None}))))
 
 (`` (def .public (code type)
-      (-> Type Code)
+      (-> Type
+          Code)
       (when type
         {.#Nominal name params}
         (` {.#Nominal (, (code.text name))
@@ -303,7 +322,8 @@
         )))
 
 (def .public (de_aliased type)
-  (-> Type Type)
+  (-> Type
+      Type)
   (when type
     {.#Named _ {.#Named name type'}}
     (de_aliased {.#Named name type'})
@@ -312,7 +332,8 @@
     type))
 
 (def .public (anonymous type)
-  (-> Type Type)
+  (-> Type
+      Type)
   (when type
     {.#Named name type'}
     (anonymous type')
@@ -322,7 +343,8 @@
 
 (with_template [<name> <base> <ctor>]
   [(def .public (<name> types)
-     (-> (List Type) Type)
+     (-> (List Type)
+         Type)
      (when types
        {.#End}
        <base>
@@ -338,7 +360,8 @@
   )
 
 (def .public (function inputs output)
-  (-> (List Type) Type Type)
+  (-> (List Type) Type
+      Type)
   (when inputs
     {.#End}
     output
@@ -347,7 +370,8 @@
     {.#Function input (function inputs' output)}))
 
 (def .public (application params quant)
-  (-> (List Type) Type Type)
+  (-> (List Type) Type
+      Type)
   (when params
     {.#End}
     quant
@@ -357,7 +381,8 @@
 
 (with_template [<name> <tag>]
   [(def .public (<name> size body)
-     (-> Nat Type Type)
+     (-> Nat Type
+         Type)
      (when size
        0 body
        _  (|> body (<name> (-- size)) {<tag> (list)})))]
@@ -367,7 +392,8 @@
   )
 
 (`` (def .public (quantified? type)
-      (-> Type Bit)
+      (-> Type
+          Bit)
       (when type
         {.#Named [module name] _type}
         (quantified? _type)
@@ -388,7 +414,8 @@
         false)))
 
 (def .public (array depth element_type)
-  (-> Nat Type Type)
+  (-> Nat Type
+      Type)
   (when depth
     0 element_type
     _ (|> element_type
@@ -397,7 +424,8 @@
           {.#Nominal array.nominal})))
 
 (def .public (flat_array type)
-  (-> Type [Nat Type])
+  (-> Type
+      [Nat Type])
   (with_expansions [<default> [0 type]]
     (when type
       {.#Nominal name (list element_type)}
@@ -410,7 +438,8 @@
       <default>)))
 
 (def .public array?
-  (-> Type Bit)
+  (-> Type
+      Bit)
   (|>> ..flat_array
        product.left
        (n.> 0)))
@@ -432,16 +461,17 @@
       (do meta.monad
         [location meta.location
          valueT (meta.type valueN)
-         .let [_ (.log!# (all text#composite
-                              (symbol#encoded (symbol ..log!)) " " (location.format location) text.new_line
+         .let [[@ _ _] location
+               _ (.log!# (all text#composite
+                              (of symbol.absolute encoded (symbol ..log!)) " " (location.format location) text.new_line
                               "Expression: " (when valueC
                                                {.#Some valueC}
                                                (code.format valueC)
                                                
                                                {.#None}
-                                               (symbol#encoded valueN))
+                                               (of symbol.absolute encoded valueN))
                               text.new_line
-                              "      Type: " (..format valueT)))]]
+                              "      Type: " (..relative_format @ valueT)))]]
         (in (list (code.symbol valueN))))
       
       {.#Right valueC}
@@ -475,7 +505,8 @@
     #expression Code]))
 
 (def (typed lux)
-  (-> Lux (Parser Typed))
+  (-> Lux
+      (Parser Typed))
   (do <>.monad
     [it <code>.any
      type_check (<>.of_try (meta.result lux (expansion.complete it)))]
@@ -510,7 +541,8 @@
                                  (.as .Nothing [])))))))))
 
 (`` (def .public (replaced before after)
-      (-> Type Type Type Type)
+      (-> Type Type Type
+          Type)
       (.function (again it)
         (if (of ..equivalence = before it)
           after
diff --git a/stdlib/source/library/lux/meta/type/check.lux b/stdlib/source/library/lux/meta/type/check.lux
index 72dc101b3..62242e421 100644
--- a/stdlib/source/library/lux/meta/type/check.lux
+++ b/stdlib/source/library/lux/meta/type/check.lux
@@ -49,21 +49,21 @@
 (exception.def .public (invalid_type_application [funcT argT])
   (Exception [Type Type])
   (exception.report
-   (list ["Type function" (//.format funcT)]
-         ["Type argument" (//.format argT)])))
+   (list ["Type function" (//.absolute_format funcT)]
+         ["Type argument" (//.absolute_format argT)])))
 
 (exception.def .public (cannot_rebind_var [id type bound])
   (Exception [Nat Type Type])
   (exception.report
    (list ["Var" (n#encoded id)]
-         ["Wanted type" (//.format type)]
-         ["Current type" (//.format bound)])))
+         ["Wanted type" (//.absolute_format type)]
+         ["Current type" (//.absolute_format bound)])))
 
 (exception.def .public (type_check_failed [expected actual])
   (Exception [Type Type])
   (exception.report
-   (list ["Expected" (//.format expected)]
-         ["Actual" (//.format actual)])))
+   (list ["Expected" (//.absolute_format expected)]
+         ["Actual" (//.absolute_format actual)])))
 
 (type .public Var
   Nat)
diff --git a/stdlib/source/library/lux/meta/type/nominal.lux b/stdlib/source/library/lux/meta/type/nominal.lux
index a9ddf084d..73e776829 100644
--- a/stdlib/source/library/lux/meta/type/nominal.lux
+++ b/stdlib/source/library/lux/meta/type/nominal.lux
@@ -14,7 +14,7 @@
     [collection
      ["[0]" list (.use "[1]#[0]" functor)]]]
    [meta
-    ["[0]" symbol (.use "[1]#[0]" codec)]
+    ["[0]" symbol (.use "[1]#[0]" absolute)]
     ["[0]" code (.only)
      ["<[1]>" \\parser (.only Parser)]]
     ["[0]" macro (.only)
-- 
cgit v1.2.3