From a6f04f38c0170e93e8f1ab2cfcde3cbf59f88b0b Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 17 Mar 2019 12:36:38 -0400
Subject: Added proper aliasing support to the new compiler.

Also improved aliasing support in the old compiler.---
 luxc/src/lux/analyser.clj                          |  8 ++++++++
 luxc/src/lux/analyser/lux.clj                      | 20 ++++++++++++++++++
 stdlib/source/lux.lux                              |  7 +------
 .../tool/compiler/phase/extension/statement.lux    | 24 +++++++++++++++-------
 4 files changed, 46 insertions(+), 13 deletions(-)

diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj
index 068a321d0..e272bcea4 100644
--- a/luxc/src/lux/analyser.clj
+++ b/luxc/src/lux/analyser.clj
@@ -136,6 +136,14 @@
             (&/with-cursor cursor
               (&&lux/analyse-def analyse optimize eval! compile-def ?name ?value ?meta)))
 
+          "lux def alias"
+          (|let [(&/$Cons [_ (&/$Identifier "" ?alias)]
+                          (&/$Cons [_ (&/$Identifier ?original)]
+                                   (&/$Nil)
+                                   )) parameters]
+            (&/with-cursor cursor
+              (&&lux/analyse-def-alias ?alias ?original)))
+
           "lux program"
           (|let [(&/$Cons ?program (&/$Nil)) parameters]
             (&/with-cursor cursor
diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj
index 236eb10a9..dc08ac765 100644
--- a/luxc/src/lux/analyser/lux.clj
+++ b/luxc/src/lux/analyser/lux.clj
@@ -559,6 +559,26 @@
         _ &type/reset-mappings]
     (return &/$Nil)))
 
+(def ^:private dummy-cursor
+  (&/T ["" -1 -1]))
+
+(defn ^:private alias-annotations [original-module original-name]
+  (&/T [dummy-cursor
+        (&/$Record (&/$Cons (&/T [(&/T [dummy-cursor (&/$Tag &&meta/alias-tag)])
+                                  (&/T [dummy-cursor (&/$Identifier (&/T [original-module original-name]))])])
+                            &/$Nil))]))
+
+(defn analyse-def-alias [?alias ?original]
+  (|let [[r-module r-name] ?original]
+    (|do [[_ [original-type original-anns original-value]] (&&module/find-def! r-module r-name)
+          module-name &/get-module-name
+          _ (&/without-repl-closure
+             (&&module/define module-name ?alias
+               original-type
+               (alias-annotations r-module r-name)
+               original-value))]
+      (return &/$Nil))))
+
 (defn ^:private merge-module-states
   "(-> Host Host Host)"
   [new old]
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 2b99f51f8..549d63112 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -4841,12 +4841,7 @@
              (wrap (list)))
      #let [defs (list;map (: (-> Text Code)
                              (function (_ def)
-                               (` ("lux def" (~ (identifier$ ["" def]))
-                                   (~ (identifier$ [module-name def]))
-                                   [(~ cursor-code)
-                                    (#.Record (#Cons [[(~ cursor-code) (#.Tag ["lux" "alias"])]
-                                                      [(~ cursor-code) (#.Identifier [(~ (text$ module-name)) (~ (text$ def))])]]
-                                                     #Nil))]))))
+                               (` ("lux def alias" (~ (identifier$ ["" def])) (~ (identifier$ [module-name def]))))))
                           defs')
            openings (join-map (: (-> Openings (List Code))
                                  (function (_ [alias structs])
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux
index e36af0de6..e8910a3fb 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux
@@ -11,6 +11,7 @@
      ["." list ("#;." functor)]
      ["." dictionary]]]
    ["." macro
+    ["." code]
     ["s" syntax (#+ Syntax)]]
    [type (#+ :share :by-example)
     ["." check]]]
@@ -145,12 +146,6 @@
       _
       (///.throw //.invalid-syntax [extension-name]))))
 
-(def: (alias! alias def-name)
-  (-> Text Name (////analysis.Operation Any))
-  (do ///.monad
-    [definition (//.lift (macro.find-def def-name))]
-    (module.define alias definition)))
-
 (def: imports
   (Syntax (List Import))
   (|> (s.tuple (p.and s.text s.text))
@@ -187,6 +182,21 @@
       _
       (///.throw //.invalid-syntax [extension-name]))))
 
+## TODO: Reify aliasing as a feature of the compiler, instead of
+## manifesting it implicitly through definition annotations.
+(def: (alias-annotations original)
+  (-> Name Code)
+  (` {#.alias (~ (code.identifier original))}))
+
+(def: (define-alias alias original)
+  (-> Text Name (////analysis.Operation Any))
+  (do ///.monad
+    [[original-type original-annotations original-value]
+     (//.lift (macro.find-def original))]
+    (module.define alias [original-type
+                          (alias-annotations original)
+                          original-value])))
+
 (def: def::alias
   Handler
   (function (_ extension-name phase inputsC+)
@@ -196,7 +206,7 @@
         [_ (//.lift
             (///.sub [(get@ [#////statement.analysis #////statement.state])
                       (set@ [#////statement.analysis #////statement.state])]
-                     (alias! alias def-name)))]
+                     (define-alias alias def-name)))]
         (wrap ////statement.no-requirements))
 
       _
-- 
cgit v1.2.3