From fa251c2a22f004cd66461d2a8a101f2d88b15460 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 3 May 2015 21:05:16 -0400
Subject: - Added def-aliasing. - | and & now normalize their slot-names. -
 Added several implementations of Eq, Ord & Show.

---
 src/lux/analyser/lux.clj    | 48 +++++++++++++++++++++++++++------------------
 src/lux/analyser/module.clj | 20 +++++++++++++++++++
 src/lux/type.clj            |  8 +++++---
 3 files changed, 54 insertions(+), 22 deletions(-)

(limited to 'src')

diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 47c18aded..b8ffafd59 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -114,6 +114,15 @@
                        ?elems)]
     (return (&/|list (&/T (&/V "record" =slots) (&/V "lux;RecordT" exo-type))))))
 
+(defn find-def+ [?module ?name]
+  (|do [$def (&&module/find-def ?module ?name)]
+    (matchv ::M/objects [$def]
+      [["lux;AliasD" [?r-module ?r-name]]]
+      (find-def+ ?r-module ?r-name)
+
+      [_]
+      (return $def))))
+
 (defn analyse-symbol [analyse exo-type ident]
   (|do [module-name &/get-module-name]
     (fn [state]
@@ -126,10 +135,8 @@
              [inner outer] (&/|split-with no-binding? stack)]
         (matchv ::M/objects [outer]
           [["lux;Nil" _]]
-          (&/run-state (|do [$def (&&module/find-def (if (= "" ?module) module-name ?module)
-                                                     ?name)
-                             ;; :let [_ (println "Found def:" (if (= "" ?module) module-name ?module)
-                             ;;                  ?name)]
+          (&/run-state (|do [$def (find-def+ (if (= "" ?module) module-name ?module)
+                                             ?name)
                              endo-type (matchv ::M/objects [$def]
                                          [["lux;ValueD" ?type]]
                                          (return ?type)
@@ -364,22 +371,25 @@
       (|do [;; :let [_ (prn 'analyse-def/_0)]
             =value (&/with-scope ?name
                      (analyse-1+ analyse ?value))
-            ;; :let [_ (prn 'analyse-def/_1)]
-            =value-type (&&/expr-type =value)
-            ;; :let [_ (prn 'analyse-def/_2)]
-            ;; _ &type/delete-vars
-            :let [_ (prn 'analyse-def/TYPE ?name ;; (&type/show-type =value-type)
-                         )
-                  _ (println)
-                  def-data (cond (&type/type= &type/Type =value-type)
-                                 (&/V "lux;TypeD" nil)
-                                 
-                                 :else
-                                 (&/V "lux;ValueD" =value-type))]
-            _ (&&module/define module-name ?name def-data)
-            ;; :let [_ (prn 'analyse-def/_3)]
+            ;; :let [_ (prn 'analyse-def/_1 (aget =value 0 0))]
             ]
-        (return (&/|list (&/V "def" (&/T ?name =value def-data))))))))
+        (matchv ::M/objects [=value]
+          [["global" [?r-module ?r-name]]]
+          (|do [_ (&&module/def-alias module-name ?name ?r-module ?r-name)]
+            (return (&/|list)))
+
+          [_]
+          (|do [=value-type (&&/expr-type =value)
+                :let [_ (prn 'analyse-def/END ?name)
+                      _ (println)
+                      def-data (cond (&type/type= &type/Type =value-type)
+                                     (&/V "lux;TypeD" nil)
+                                     
+                                     :else
+                                     (&/V "lux;ValueD" =value-type))]
+                _ (&&module/define module-name ?name def-data)]
+            (return (&/|list (&/V "def" (&/T ?name =value def-data))))))
+        ))))
 
 (defn analyse-declare-macro [analyse ?name]
   (|do [module-name &/get-module-name
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index d2e0a745b..6e42a56f7 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -30,6 +30,26 @@
       [_]
       (fail* "[Analyser Error] Can't create a new global definition outside of a global environment."))))
 
+(defn def-alias [a-module a-name r-module r-name]
+  (fn [state]
+    (matchv ::M/objects [(&/get$ &/$ENVS state)]
+      [["lux;Cons" [?env ["lux;Nil" _]]]]
+      (return* (->> state
+                    (&/update$ &/$MODULES (fn [ms]
+                                            (&/|update a-module #(&/|put a-name (&/V "lux;AliasD" (&/T r-module r-name)) %)
+                                                       ms)))
+                    (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals]
+                                                                    (&/update$ &/$MAPPINGS (fn [mappings]
+                                                                                             (&/|put (str "" &/+name-separator+ name)
+                                                                                                     (&/T (&/V "global" (&/T r-module r-name)) &type/$Void)
+                                                                                                     mappings))
+                                                                               locals))
+                                                        ?env))))
+               nil)
+      
+      [_]
+      (fail* "[Analyser Error] Can't alias a global definition outside of a global environment."))))
+
 (defn exists? [name]
   (fn [state]
     ;; (prn `exists? name (->> state (&/get$ &/$MODULES) (&/|contains? name)))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index c8ee06059..38f848676 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -77,12 +77,13 @@
               (&/V "lux;VariantT" (&/|list (&/T "lux;Meta" (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "m")
                                                                                       (&/V "lux;BoundT" "v")))))))))
 
+(def Ident (&/V "lux;TupleT" (&/|list Text Text)))
+
 (def Syntax*
   (let [Syntax* (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "w")
                                      (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "Syntax'")
                                                           (&/V "lux;BoundT" "w")))))
-        Syntax*List (&/V "lux;AppT" (&/T List Syntax*))
-        Ident (&/V "lux;TupleT" (&/|list Text Text))]
+        Syntax*List (&/V "lux;AppT" (&/T List Syntax*))]
     (fAll "Syntax'" "w"
           (&/V "lux;VariantT" (&/|list (&/T "lux;Bool" Bool)
                                        (&/T "lux;Int" Int)
@@ -131,7 +132,8 @@
   (fAll "DefData'" ""
         (&/V "lux;VariantT" (&/|list (&/T "lux;TypeD" Unit)
                                      (&/T "lux;ValueD" Type)
-                                     (&/T "lux;MacroD" (&/V "lux;BoundT" ""))))))
+                                     (&/T "lux;MacroD" (&/V "lux;BoundT" ""))
+                                     (&/T "lux;AliasD" Ident)))))
 
 (def CompilerState
   (&/V "lux;AppT" (&/T (fAll "CompilerState" ""
-- 
cgit v1.2.3