From b7f62d92c3ed9dcd0d2d48d680798114ad64c9df Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 1 Jun 2019 21:46:18 -0400
Subject: Removed the (magical) "alias" annotations tag.
---
luxc/src/lux/analyser/lux.clj | 19 +-----
luxc/src/lux/analyser/meta.clj | 44 -------------
luxc/src/lux/analyser/module.clj | 124 +++++++++++++++++-------------------
luxc/src/lux/compiler/cache.clj | 11 +---
luxc/src/lux/compiler/core.clj | 11 ++--
luxc/src/lux/compiler/jvm/cache.clj | 3 +-
luxc/src/lux/compiler/jvm/lux.clj | 92 +++++++++++---------------
7 files changed, 108 insertions(+), 196 deletions(-)
delete mode 100644 luxc/src/lux/analyser/meta.clj
(limited to 'luxc/src')
diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj
index 4353caefa..0a6858a92 100644
--- a/luxc/src/lux/analyser/lux.clj
+++ b/luxc/src/lux/analyser/lux.clj
@@ -12,8 +12,7 @@
[case :as &&case]
[env :as &&env]
[module :as &&module]
- [record :as &&record]
- [meta :as &&meta])))
+ [record :as &&record])))
;; [Utils]
;; TODO: Walk the type to set up the parameter-type, instead of doing a
@@ -579,24 +578,12 @@
_ (&&module/declare-tags module-name tags exported? def-value)]
(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 [[_ [exported? original-type original-anns original-value]] (&&module/find-def! r-module r-name)
+ (|do [_ (&&module/find-def r-module r-name)
module-name &/get-module-name
_ (&/without-repl-closure
- (&&module/define module-name ?alias false
- original-type
- (alias-annotations r-module r-name)
- original-value))]
+ (&&module/define-alias module-name ?alias ?original))]
(return &/$Nil))))
(defn ^:private merge-module-states
diff --git a/luxc/src/lux/analyser/meta.clj b/luxc/src/lux/analyser/meta.clj
deleted file mode 100644
index 53d355867..000000000
--- a/luxc/src/lux/analyser/meta.clj
+++ /dev/null
@@ -1,44 +0,0 @@
-(ns lux.analyser.meta
- (:require (clojure [template :refer [do-template]])
- clojure.core.match
- clojure.core.match.array
- (lux [base :as & :refer [|let |do return return* |case]])))
-
-;; [Utils]
-(defn ^:private ident= [x y]
- (|let [[px nx] x
- [py ny] y]
- (and (= px py)
- (= nx ny))))
-
-(def ^:private tag-prefix "lux")
-
-;; [Values]
-(defn meta-get
- "(-> Ident Code (Maybe Code))"
- [ident annotations]
- (|case annotations
- [_ (&/$Record dict)]
- (loop [dict dict]
- (|case dict
- (&/$Cons [_k v] dict*)
- (|case _k
- [_ (&/$Tag k)]
- (if (ident= k ident)
- (&/$Some v)
- (recur dict*))
-
- _
- (recur dict*))
-
- (&/$Nil)
- &/$None))
-
- _
- &/$None))
-
-(do-template [<name> <tag-name>]
- (def <name> (&/T [tag-prefix <tag-name>]))
-
- alias-tag "alias"
- )
diff --git a/luxc/src/lux/analyser/module.clj b/luxc/src/lux/analyser/module.clj
index 25f6428ca..3d53155cb 100644
--- a/luxc/src/lux/analyser/module.clj
+++ b/luxc/src/lux/analyser/module.clj
@@ -7,8 +7,7 @@
(lux [base :as & :refer [defvariant deftuple |let |do return return* |case]]
[type :as &type]
[host :as &host])
- [lux.host.generics :as &host-generics]
- (lux.analyser [meta :as &meta])))
+ [lux.host.generics :as &host-generics]))
;; [Utils]
;; ModuleState
@@ -106,10 +105,8 @@
state)
nil))))
-(defn define [module name exported? def-type def-meta def-value]
+(defn define-alias [module name de-aliased]
(fn [state]
- (when (and (= "Macro'" name) (= "lux" module))
- (&type/set-macro*-type! def-value))
(|case (&/get$ &/$scopes state)
(&/$Cons ?env (&/$Nil))
(return* (->> state
@@ -118,7 +115,7 @@
(&/|update module
(fn [m]
(&/update$ $defs
- #(&/|put name (&/T [exported? def-type def-meta def-value]) %)
+ #(&/|put name (&/$Left de-aliased) %)
m))
ms))))
nil)
@@ -127,17 +124,25 @@
((&/fail-with-loc (str "[Analyser Error] Cannot create a new global definition outside of a global environment: " (str module &/+name-separator+ name)))
state))))
-(defn def-type
- "(-> Text Text (Lux Type))"
- [module name]
+(defn define [module name exported? def-type def-meta def-value]
(fn [state]
- (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))]
- (if-let [$def (->> $module (&/get$ $defs) (&/|get name))]
- (|let [[exported? ?type ?meta ?value] $def]
- (return* state ?type))
- ((&/fail-with-loc (str "[Analyser Error] Unknown definition: " (str module &/+name-separator+ name)))
- state))
- ((&/fail-with-loc (str "[Analyser Error] Unknown module: " module))
+ (when (and (= "Macro'" name) (= "lux" module))
+ (&type/set-macro*-type! def-value))
+ (|case (&/get$ &/$scopes state)
+ (&/$Cons ?env (&/$Nil))
+ (return* (->> state
+ (&/update$ &/$modules
+ (fn [ms]
+ (&/|update module
+ (fn [m]
+ (&/update$ $defs
+ #(&/|put name (&/$Right (&/T [exported? def-type def-meta def-value])) %)
+ m))
+ ms))))
+ nil)
+
+ _
+ ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global definition outside of a global environment: " (str module &/+name-separator+ name)))
state))))
(defn type-def
@@ -146,7 +151,11 @@
(fn [state]
(if-let [$module (->> state (&/get$ &/$modules) (&/|get module))]
(if-let [$def (->> $module (&/get$ $defs) (&/|get name))]
- (|let [[exported? ?type ?meta ?value] $def]
+ (|case $def
+ (&/$Left [o-module o-name])
+ ((type-def o-module o-name) state)
+
+ (&/$Right [exported? ?type ?meta ?value])
(if (&type/type= &type/Type ?type)
(return* state (&/T [exported? ?value]))
((&/fail-with-loc (str "[Analyser Error] Not a type: " (&/ident->text (&/T [module name]))
@@ -224,56 +233,50 @@
(fn [state]
(if-let [$module (->> state (&/get$ &/$modules) (&/|get module))]
(if-let [$def (->> $module (&/get$ $defs) (&/|get name))]
- (|let [[exported? ?type ?meta ?value] $def]
- (if (.equals ^Object current-module module)
- (|case (&meta/meta-get &meta/alias-tag ?meta)
- (&/$Some [_ (&/$Identifier [?r-module ?r-name])])
- ((find-def! ?r-module ?r-name)
- state)
+ (|case $def
+ (&/$Left [?r-module ?r-name])
+ ((find-def! ?r-module ?r-name)
+ state)
- _
- (return* state (&/T [(&/T [module name]) $def])))
- (return* state (&/T [(&/T [module name]) $def]))))
+ (&/$Right $def*)
+ (return* state (&/T [(&/T [module name]) $def*])))
((&/fail-with-loc (str "[Analyser Error @ find-def!] Definition does not exist: " (str module &/+name-separator+ name)
" at module: " current-module))
state))
((&/fail-with-loc (str "[Analyser Error @ find-def!] Module does not exist: " module
" at module: " current-module))
- state))
- )))
+ state)))))
(defn find-def [module name]
(|do [current-module &/get-module-name]
(fn [state]
- (if (or (= "lux" module)
- (= current-module module)
- (imports? state module current-module))
- (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))]
- (if-let [$def (->> $module (&/get$ $defs) (&/|get name))]
- (|let [[exported? ?type ?meta ?value] $def]
- (if (.equals ^Object current-module module)
- (|case (&meta/meta-get &meta/alias-tag ?meta)
- (&/$Some [_ (&/$Identifier [?r-module ?r-name])])
- ((find-def ?r-module ?r-name)
- state)
-
- _
- (return* state (&/T [(&/T [module name]) $def])))
- (if exported?
- (return* state (&/T [(&/T [module name]) $def]))
- ((&/fail-with-loc (str "[Analyser Error @ find-def] Cannot use private definition: " (str module &/+name-separator+ name)
- " at module: " current-module))
- state))))
- ((&/fail-with-loc (str "[Analyser Error @ find-def] Definition does not exist: " (str module &/+name-separator+ name)
- " at module: " current-module))
- state))
- ((&/fail-with-loc (str "[Analyser Error @ find-def] Module does not exist: " module
+ (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))]
+ (if-let [$def (->> $module (&/get$ $defs) (&/|get name))]
+ (|case $def
+ (&/$Left [?r-module ?r-name])
+ (if (.equals ^Object current-module module)
+ ((find-def! ?r-module ?r-name)
+ state)
+ ((&/fail-with-loc (str "[Analyser Error @ find-def] Cannot use (private) alias: " (str module &/+name-separator+ name)
+ " at module: " current-module))
+ state))
+
+ (&/$Right [exported? ?type ?meta ?value])
+ (if (or (.equals ^Object current-module module)
+ (and exported?
+ (or (.equals ^Object module "lux")
+ (imports? state module current-module))))
+ (return* state (&/T [(&/T [module name])
+ (&/T [exported? ?type ?meta ?value])]))
+ ((&/fail-with-loc (str "[Analyser Error @ find-def] Cannot use private definition: " (str module &/+name-separator+ name)
+ " at module: " current-module))
+ state)))
+ ((&/fail-with-loc (str "[Analyser Error @ find-def] Definition does not exist: " (str module &/+name-separator+ name)
" at module: " current-module))
state))
- ((&/fail-with-loc (str "[Analyser Error @ find-def] Unknown module: " module
+ ((&/fail-with-loc (str "[Analyser Error @ find-def] Module does not exist: " module
" at module: " current-module))
- state))
- )))
+ state)))))
(defn defined? [module name]
(&/try-all% (&/|list (|do [_ (find-def! module name)]
@@ -398,18 +401,7 @@
(def defs
(|do [module &/get-module-name]
(fn [state]
- (return* state
- (->> state (&/get$ &/$modules) (&/|get module) (&/get$ $defs)
- (&/|map (fn [kv]
- (|let [[k _def-data] kv
- [_ _ ?def-meta _] _def-data]
- (|case (&meta/meta-get &meta/alias-tag ?def-meta)
- (&/$Some [_ (&/$Identifier [?r-module ?r-name])])
- (&/T [k (str ?r-module &/+name-separator+ ?r-name) _def-data])
-
- _
- (&/T [k "" _def-data])
- )))))))))
+ (return* state (->> state (&/get$ &/$modules) (&/|get module) (&/get$ $defs))))))
(defn fetch-imports [imports]
(|case imports
diff --git a/luxc/src/lux/compiler/cache.clj b/luxc/src/lux/compiler/cache.clj
index 06dabe108..a0f88aa09 100644
--- a/luxc/src/lux/compiler/cache.clj
+++ b/luxc/src/lux/compiler/cache.clj
@@ -8,8 +8,7 @@
[type :as &type]
[host :as &host])
(lux.analyser [base :as &a]
- [module :as &a-module]
- [meta :as &a-meta])
+ [module :as &a-module])
(lux.compiler [core :as &&core]
[io :as &&io])
(lux.compiler.cache [type :as &&&type]
@@ -99,12 +98,8 @@
(let [parts (.split _def-entry &&core/datum-separator)]
(case (alength parts)
2 (let [[_name _alias] parts
- [_ __module __name] (re-find #"^(.*)\.(.*)$" _alias)
- def-anns (make-record (&/|list (&/T [(make-tag &a-meta/alias-tag)
- (make-identifier (&/T [__module __name]))])))]
- (|do [def-type (&a-module/def-type __module __name)
- def-value (load-def-value __module __name)]
- (&a-module/define module _name false def-type def-anns def-value)))
+ [__module __name] (.split _alias &/+name-separator+)]
+ (&a-module/define-alias module _name (&/T [__module __name])))
4 (let [[_name _exported? _type _anns] parts
[def-anns _] (&&&ann/deserialize _anns)
[def-type _] (&&&type/deserialize-type _type)]
diff --git a/luxc/src/lux/compiler/core.clj b/luxc/src/lux/compiler/core.clj
index f2fe09887..88da626bd 100644
--- a/luxc/src/lux/compiler/core.clj
+++ b/luxc/src/lux/compiler/core.clj
@@ -50,13 +50,16 @@
tag-groups &a-module/tag-groups
:let [def-entries (->> defs
(&/|map (fn [_def]
- (|let [[?name ?alias [exported? ?def-type ?def-anns ?def-value]] _def]
- (if (= "" ?alias)
+ (|let [[?name _definition] _def]
+ (|case _definition
+ (&/$Left [_dmodule _dname])
+ (str ?name datum-separator _dmodule &/+name-separator+ _dname)
+
+ (&/$Right [exported? ?def-type ?def-anns ?def-value])
(str ?name
datum-separator (if exported? "1" "0")
datum-separator (&&&type/serialize-type ?def-type)
- datum-separator (&&&ann/serialize ?def-anns))
- (str ?name datum-separator ?alias)))))
+ datum-separator (&&&ann/serialize ?def-anns))))))
(&/|interpose entry-separator)
(&/fold str ""))
import-entries (->> imports
diff --git a/luxc/src/lux/compiler/jvm/cache.clj b/luxc/src/lux/compiler/jvm/cache.clj
index a42c7afdd..f54eacc92 100644
--- a/luxc/src/lux/compiler/jvm/cache.clj
+++ b/luxc/src/lux/compiler/jvm/cache.clj
@@ -9,8 +9,7 @@
[host :as &host])
[lux.host.generics :as &host-generics]
(lux.analyser [base :as &a]
- [module :as &a-module]
- [meta :as &a-meta])
+ [module :as &a-module])
(lux.compiler [core :as &&core]
[io :as &&io])
(lux.compiler.jvm [base :as &&]))
diff --git a/luxc/src/lux/compiler/jvm/lux.clj b/luxc/src/lux/compiler/jvm/lux.clj
index 28418a6f8..bfa8b2bdb 100644
--- a/luxc/src/lux/compiler/jvm/lux.clj
+++ b/luxc/src/lux/compiler/jvm/lux.clj
@@ -13,8 +13,7 @@
[optimizer :as &o])
[lux.host.generics :as &host-generics]
(lux.analyser [base :as &a]
- [module :as &a-module]
- [meta :as &a-meta])
+ [module :as &a-module])
(lux.compiler.jvm [base :as &&]
[function :as &&function]))
(:import (org.objectweb.asm Opcodes
@@ -268,71 +267,26 @@
(defn compile-def [compile ?name ?body ?meta exported?]
(|do [module-name &/get-module-name
class-loader &/loader]
- (|case (&a-meta/meta-get &a-meta/alias-tag ?meta)
- (&/$Some [_ (&/$Identifier [r-module r-name])])
- (|case ?meta
- [_ (&/$Record ?meta*)]
- (if (= 1 (&/|length ?meta*))
- (|do [:let [current-class (&host-generics/->class-name (str (&host/->module-class r-module) "/" (&host/def-name r-name)))
- def-class (&&/load-class! class-loader current-class)
- def-value (-> def-class (.getField &/value-field) (.get nil))]
- def-type (&a-module/def-type r-module r-name)
- _ (&/without-repl-closure
- (&a-module/define module-name ?name false def-type ?meta def-value))]
- (return nil))
- (&/fail-with-loc (str "[Compilation Error] Aliases cannot contain meta-data: " (str module-name &/+name-separator+ ?name)))))
-
- (&/$Some _)
- (&/fail-with-loc "[Compilation Error] Invalid syntax for lux;alias meta-data. Must be an identifier.")
-
- _
- (|case (de-ann ?body)
- [_ (&o/$function _ _ __scope _ _)]
- (|let [[_ (&o/$function _ _arity _scope _captured ?body+)] (&o/shift-function-body (&/|tail __scope) __scope
- false
- (de-ann ?body))]
- (|do [[file-name _ _] &/cursor
- :let [datum-sig "Ljava/lang/Object;"
- def-name (&host/def-name ?name)
- current-class (str (&host/->module-class module-name) "/" def-name)
- =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
- (.visit &host/bytecode-version class-flags
- current-class nil &&/function-class (into-array String []))
- (-> (.visitField field-flags &/value-field datum-sig nil nil)
- (doto (.visitEnd)))
- (.visitSource file-name nil))]
- instancer (&&function/compile-function compile (&/$Some =class) _arity _scope _captured ?body+)
- _ (&/with-writer (.visitMethod =class Opcodes/ACC_STATIC "<clinit>" "()V" nil nil)
- (|do [^MethodVisitor **writer** &/get-writer
- :let [_ (.visitCode **writer**)]
- _ instancer
- :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/value-field datum-sig)]
- :let [_ (doto **writer**
- (.visitInsn Opcodes/RETURN)
- (.visitMaxs 0 0)
- (.visitEnd))]]
- (return nil)))
- :let [_ (.visitEnd =class)]
- _ (&&/save-class! def-name (.toByteArray =class))
- def-value (install-def! class-loader current-class module-name ?name ?body ?meta exported?)
- :let [_ (println 'DEF (str module-name &/+name-separator+ ?name))]]
- (return def-value)))
-
- _
+ (|case (de-ann ?body)
+ [_ (&o/$function _ _ __scope _ _)]
+ (|let [[_ (&o/$function _ _arity _scope _captured ?body+)] (&o/shift-function-body (&/|tail __scope) __scope
+ false
+ (de-ann ?body))]
(|do [[file-name _ _] &/cursor
:let [datum-sig "Ljava/lang/Object;"
def-name (&host/def-name ?name)
current-class (str (&host/->module-class module-name) "/" def-name)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit &host/bytecode-version class-flags
- current-class nil "java/lang/Object" (into-array String []))
+ current-class nil &&/function-class (into-array String []))
(-> (.visitField field-flags &/value-field datum-sig nil nil)
(doto (.visitEnd)))
(.visitSource file-name nil))]
+ instancer (&&function/compile-function compile (&/$Some =class) _arity _scope _captured ?body+)
_ (&/with-writer (.visitMethod =class Opcodes/ACC_STATIC "<clinit>" "()V" nil nil)
(|do [^MethodVisitor **writer** &/get-writer
:let [_ (.visitCode **writer**)]
- _ (compile nil ?body)
+ _ instancer
:let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/value-field datum-sig)]
:let [_ (doto **writer**
(.visitInsn Opcodes/RETURN)
@@ -344,7 +298,33 @@
def-value (install-def! class-loader current-class module-name ?name ?body ?meta exported?)
:let [_ (println 'DEF (str module-name &/+name-separator+ ?name))]]
(return def-value)))
- ))))
+
+ _
+ (|do [[file-name _ _] &/cursor
+ :let [datum-sig "Ljava/lang/Object;"
+ def-name (&host/def-name ?name)
+ current-class (str (&host/->module-class module-name) "/" def-name)
+ =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+ (.visit &host/bytecode-version class-flags
+ current-class nil "java/lang/Object" (into-array String []))
+ (-> (.visitField field-flags &/value-field datum-sig nil nil)
+ (doto (.visitEnd)))
+ (.visitSource file-name nil))]
+ _ (&/with-writer (.visitMethod =class Opcodes/ACC_STATIC "<clinit>" "()V" nil nil)
+ (|do [^MethodVisitor **writer** &/get-writer
+ :let [_ (.visitCode **writer**)]
+ _ (compile nil ?body)
+ :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/value-field datum-sig)]
+ :let [_ (doto **writer**
+ (.visitInsn Opcodes/RETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))]]
+ (return nil)))
+ :let [_ (.visitEnd =class)]
+ _ (&&/save-class! def-name (.toByteArray =class))
+ def-value (install-def! class-loader current-class module-name ?name ?body ?meta exported?)
+ :let [_ (println 'DEF (str module-name &/+name-separator+ ?name))]]
+ (return def-value))))))
(defn compile-program [compile ?program]
(|do [module-name &/get-module-name
--
cgit v1.2.3