aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser.clj5
-rw-r--r--src/lux/analyser/lux.clj43
-rw-r--r--src/lux/analyser/module.clj97
-rw-r--r--src/lux/base.clj2
-rw-r--r--src/lux/compiler/host.clj8
-rw-r--r--src/lux/compiler/type.clj4
-rw-r--r--src/lux/host.clj7
-rw-r--r--src/lux/parser.clj4
-rw-r--r--src/lux/reader.clj14
-rw-r--r--src/lux/type.clj54
10 files changed, 149 insertions, 89 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 3b6a93005..8c88328f5 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -442,9 +442,10 @@
(&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_lux_declare-tags"))
(&/$Cons (&/$Meta _ (&/$TupleS tags))
- (&/$Nil))))
+ (&/$Cons (&/$Meta _ (&/$SymbolS "" type-name))
+ (&/$Nil)))))
(|do [tags* (&/map% parse-tag tags)]
- (&&lux/analyse-declare-tags tags*))
+ (&&lux/analyse-declare-tags tags* type-name))
(&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_lux_import"))
(&/$Cons (&/$Meta _ (&/$TextS ?path))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 8a79e0494..d241201f4 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -300,8 +300,8 @@
macro-expansion #(-> macro (.apply ?args) (.apply %))
;; :let [_ (prn 'MACRO-EXPAND|POST (&/ident->text real-name))]
;; :let [macro-expansion* (&/|map (partial with-cursor form-cursor) macro-expansion)]
- ;; :let [_ (when (or (= ":" (aget real-name 1))
- ;; (= "type" (aget real-name 1))
+ ;; :let [_ (when (or (= "defsig" (aget real-name 1))
+ ;; ;; (= "type" (aget real-name 1))
;; ;; (= &&/$struct r-name)
;; )
;; (->> (&/|map &/show-ast macro-expansion)
@@ -409,7 +409,7 @@
(analyse-1+ analyse ?value))
=value-type (&&/expr-type =value)]
(|case =value
- [(&/$Global ?r-module ?r-name) _]
+ [(&&/$var (&/$Global ?r-module ?r-name)) _]
(|do [_ (&&module/def-alias module-name ?name ?r-module ?r-name =value-type)
;; :let [_ (println 'analyse-def/ALIAS (str module-name ";" ?name) '=> (str ?r-module ";" ?r-name))
;; _ (println)]
@@ -418,10 +418,10 @@
_
(do ;; (println 'DEF (str module-name ";" ?name))
- (|do [_ (compile-token (&/V &&/$def (&/T ?name =value)))
- :let [;; _ (println 'DEF/COMPILED (str module-name ";" ?name))
- _ (println 'DEF (str module-name ";" ?name))]]
- (return (&/|list)))))
+ (|do [_ (compile-token (&/V &&/$def (&/T ?name =value)))
+ :let [;; _ (println 'DEF/COMPILED (str module-name ";" ?name))
+ _ (println 'DEF (str module-name ";" ?name))]]
+ (return (&/|list)))))
))))
(defn analyse-declare-macro [analyse compile-token ?name]
@@ -433,28 +433,13 @@
]
(return (&/|list))))
-(defn ensure-undeclared-tags [module tags]
- (|do [;; :let [_ (prn 'ensure-undeclared-tags/_0)]
- tags-table (&&module/tags-by-module module)
- ;; :let [_ (prn 'ensure-undeclared-tags/_1)]
- _ (&/map% (fn [tag]
- (if (&/|get tag tags-table)
- (fail (str "[Analyser Error] Can't re-declare tag: " (&/ident->text (&/T module tag))))
- (return nil)))
- tags)
- ;; :let [_ (prn 'ensure-undeclared-tags/_2)]
- ]
- (return nil)))
-
-(defn analyse-declare-tags [tags]
- (|do [;; :let [_ (prn 'analyse-declare-tags/_0)]
- module-name &/get-module-name
- ;; :let [_ (prn 'analyse-declare-tags/_1)]
- _ (ensure-undeclared-tags module-name tags)
- ;; :let [_ (prn 'analyse-declare-tags/_2)]
- _ (&&module/declare-tags module-name tags)
- ;; :let [_ (prn 'analyse-declare-tags/_3)]
- ]
+(defn analyse-declare-tags [tags type-name]
+ (|do [module-name &/get-module-name
+ ;; :let [_ (prn 'analyse-declare-tags (&/ident->text (&/T module-name type-name)) (&/->seq tags))]
+ [_ def-data] (&&module/find-def module-name type-name)
+ ;; :let [_ (prn 'analyse-declare-tags (&/ident->text (&/T module-name type-name)) (&/->seq tags) (&/adt->text def-data))]
+ def-type (&&module/ensure-type-def def-data)
+ _ (&&module/declare-tags module-name tags def-type)]
(return (&/|list))))
(defn analyse-import [analyse compile-module compile-token ?path]
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index 08ad0b9a5..5190e2dcf 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -8,7 +8,8 @@
(ns lux.analyser.module
(:refer-clojure :exclude [alias])
- (:require [clojure.string :as string]
+ (:require (clojure [string :as string]
+ [template :refer [do-template]])
clojure.core.match
clojure.core.match.array
(lux [base :as & :refer [deftags |let |do return return* fail fail* |case]]
@@ -20,7 +21,8 @@
"module-aliases"
"defs"
"imports"
- "tags")
+ "tags"
+ "types")
(def ^:private +init+
(&/T ;; "lux;module-aliases"
(&/|table)
@@ -29,7 +31,9 @@
;; "lux;imports"
(&/|list)
;; "lux;tags"
- (&/|list)
+ (&/|table)
+ ;; "lux;types"
+ (&/|table)
))
;; [Exports]
@@ -46,6 +50,7 @@
nil))))
(defn define [module name def-data type]
+ ;; (prn 'define module name (aget def-data 0) (&type/show-type type))
(fn [state]
(|case (&/get$ &/$envs state)
(&/$Cons ?env (&/$Nil))
@@ -151,6 +156,15 @@
(fail* (str "[Analyser Error] Definition does not exist: " (str module &/+name-separator+ name)))))
(fail* (str "[Analyser Error] Module doesn't exist: " module))))))
+(defn ensure-type-def [def-data]
+ "(-> DefData (Lux Type))"
+ (|case def-data
+ (&/$TypeD type)
+ (return type)
+
+ _
+ (fail (str "[Analyser Error] Not a type definition: " (&/adt->text def-data)))))
+
(defn defined? [module name]
(&/try-all% (&/|list (|do [_ (find-def module name)]
(return true))
@@ -250,32 +264,59 @@
(&/set$ &/$envs (&/|list (&/env name))))
nil)))
-(defn tags-by-module [module]
- "(-> Text (Lux (List (, Text (, Int (List Text))))))"
- (fn [state]
- (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))]
- (return* state (&/get$ $tags =module))
- (fail* (str "[Lux Error] Unknown module: " module)))
- ))
+(do-template [<name> <tag> <type>]
+ (defn <name> [module]
+ <type>
+ (fn [state]
+ (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))]
+ (return* state (&/get$ <tag> =module))
+ (fail* (str "[Lux Error] Unknown module: " module)))
+ ))
-(defn declare-tags [module tag-names]
- "(-> Text (List Text) (Lux (,)))"
- (fn [state]
- (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))]
- (let [tags (&/|map (fn [tag-name] (&/T module tag-name)) tag-names)]
- (return* (&/update$ &/$modules
- (fn [=modules]
- (&/|update module
- #(&/set$ $tags (&/fold (fn [table idx+tag-name]
- (|let [[idx tag-name] idx+tag-name]
- (&/|put tag-name (&/T idx tags) table)))
- (&/get$ $tags %)
- (&/enumerate tag-names))
- %)
- =modules))
- state)
- nil))
- (fail* (str "[Lux Error] Unknown module: " module)))))
+ tags-by-module $tags "(-> Text (Lux (List (, Text (, Int (List Text) Type)))))"
+ types-by-module $types "(-> Text (Lux (List (, Text (, (List Text) Type)))))"
+ )
+
+(defn ensure-undeclared-tags [module tags]
+ (|do [tags-table (tags-by-module module)
+ _ (&/map% (fn [tag]
+ (if (&/|get tag tags-table)
+ (fail (str "[Analyser Error] Can't re-declare tag: " (&/ident->text (&/T module tag))))
+ (return nil)))
+ tags)]
+ (return nil)))
+
+(defn ensure-undeclared-type [module name]
+ (|do [types-table (types-by-module module)
+ _ (&/assert! (nil? (&/|get name types-table)) (str "[Analyser Error] Can't re-declare type: " (&/ident->text (&/T module name))))]
+ (return nil)))
+
+(defn declare-tags [module tag-names type]
+ "(-> Text (List Text) Type (Lux (,)))"
+ (|do [;; :let [_ (prn 'declare-tags (&/->seq tag-names) (&/adt->text type))]
+ _ (ensure-undeclared-tags module tag-names)
+ type-name (&type/type-name type)
+ :let [[_module _name] type-name]
+ _ (&/assert! (= module _module)
+ (str "[Module Error] Can't define tags for a type belonging to a foreign module: " (&/ident->text type-name)))
+ _ (ensure-undeclared-type _module _name)]
+ (fn [state]
+ (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))]
+ (let [tags (&/|map (fn [tag-name] (&/T module tag-name)) tag-names)]
+ (return* (&/update$ &/$modules
+ (fn [=modules]
+ (&/|update module
+ #(->> %
+ (&/set$ $tags (&/fold (fn [table idx+tag-name]
+ (|let [[idx tag-name] idx+tag-name]
+ (&/|put tag-name (&/T idx tags type) table)))
+ (&/get$ $tags %)
+ (&/enumerate tag-names)))
+ (&/update$ $types (partial &/|put _name (&/T tags type))))
+ =modules))
+ state)
+ nil))
+ (fail* (str "[Lux Error] Unknown module: " module))))))
(defn tag-index [module tag-name]
"(-> Text Text (Lux Int))"
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 44875d1df..84b09bcac 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -86,7 +86,7 @@
"cursor"
"modules"
"envs"
- "types"
+ "type-vars"
"expected"
"seed"
"eval?"
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 78b9e72f6..0ae4ce2da 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -80,7 +80,13 @@
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class char-class) "valueOf" (str "(C)" (&host/->type-signature char-class)))
(&/$DataT _)
- nil)
+ nil
+
+ (&/$NamedT ?name ?type)
+ (prepare-return! *writer* ?type)
+
+ _
+ (assert false (str 'prepare-return! " " (&type/show-type *type*))))
*writer*))
;; [Resources]
diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj
index a7c5176ad..7e2bc6961 100644
--- a/src/lux/compiler/type.clj
+++ b/src/lux/compiler/type.clj
@@ -84,4 +84,8 @@
(&/$AppT ?fun ?arg)
(variant$ &/$AppT (tuple$ (&/|list (->analysis ?fun) (->analysis ?arg))))
+
+ (&/$NamedT [?module ?name] ?type)
+ (variant$ &/$NamedT (tuple$ (&/|list (tuple$ (&/|list (text$ ?module) (text$ ?name)))
+ (->analysis ?type))))
))
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 8ffe77b96..dfd4df23d 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -68,6 +68,7 @@
))
(defn ->java-sig [^objects type]
+ "(-> Type Text)"
(|case type
(&/$DataT ?name)
(->type-signature ?name)
@@ -77,6 +78,12 @@
(&/$TupleT (&/$Nil))
"V"
+
+ (&/$NamedT ?name ?type)
+ (->java-sig ?type)
+
+ _
+ (assert false (str '->java-sig " " (&type/show-type type)))
))
(do-template [<name> <static?>]
diff --git a/src/lux/parser.clj b/src/lux/parser.clj
index a8b2cfc16..eaa22db20 100644
--- a/src/lux/parser.clj
+++ b/src/lux/parser.clj
@@ -76,10 +76,10 @@
(return (&/|list (&/V &/$Meta (&/T meta (&/V &/$BoolS (Boolean/parseBoolean ?value))))))
($Int ?value)
- (return (&/|list (&/V &/$Meta (&/T meta (&/V &/$IntS (Integer/parseInt ?value))))))
+ (return (&/|list (&/V &/$Meta (&/T meta (&/V &/$IntS (Long/parseLong ?value))))))
($Real ?value)
- (return (&/|list (&/V &/$Meta (&/T meta (&/V &/$RealS (Float/parseFloat ?value))))))
+ (return (&/|list (&/V &/$Meta (&/T meta (&/V &/$RealS (Double/parseDouble ?value))))))
($Char ^String ?value)
(return (&/|list (&/V &/$Meta (&/T meta (&/V &/$CharS (.charAt ?value 0))))))
diff --git a/src/lux/reader.clj b/src/lux/reader.clj
index e0195658f..e3f95b5f9 100644
--- a/src/lux/reader.clj
+++ b/src/lux/reader.clj
@@ -26,7 +26,7 @@
(fail* "[Reader Error] EOF")
(&/$Cons [[file-name line-num column-num] line]
- more)
+ more)
(|case (body file-name line-num column-num line)
($No msg)
(fail* msg)
@@ -87,7 +87,7 @@
(if (= column-num* (.length line))
(&/V $Done (&/T (&/T file-name line-num column-num) match))
(&/V $Yes (&/T (&/T (&/T file-name line-num column-num) match)
- (&/T (&/T file-name line-num column-num*) line)))))
+ (&/T (&/T file-name line-num column-num*) line)))))
(&/V $No (str "[Reader Error] Pattern failed: " regex))))))
(defn read-regex2 [regex]
@@ -100,7 +100,7 @@
(if (= column-num* (.length line))
(&/V $Done (&/T (&/T file-name line-num column-num) (&/T tok1 tok2)))
(&/V $Yes (&/T (&/T (&/T file-name line-num column-num) (&/T tok1 tok2))
- (&/T (&/T file-name line-num column-num*) line)))))
+ (&/T (&/T file-name line-num column-num*) line)))))
(&/V $No (str "[Reader Error] Pattern failed: " regex))))))
(defn read-regex+ [regex]
@@ -113,7 +113,7 @@
(&/V &/$Left "[Reader Error] EOF")
(&/$Cons [[file-name line-num column-num] ^String line]
- reader**)
+ reader**)
(if-let [^String match (do ;; (prn 'read-regex+ regex line)
(re-find1! regex column-num line))]
(let [match-length (.length match)
@@ -121,8 +121,8 @@
(if (= column-num* (.length line))
(recur (str prefix match "\n") reader**)
(&/V &/$Right (&/T (&/|cons (&/T (&/T file-name line-num column-num*) line)
- reader**)
- (&/T (&/T file-name line-num column-num) (str prefix match))))))
+ reader**)
+ (&/T (&/T file-name line-num column-num) (str prefix match))))))
(&/V &/$Left (str "[Reader Error] Pattern failed: " regex))))))))
(defn read-text [^String text]
@@ -135,7 +135,7 @@
(if (= column-num* (.length line))
(&/V $Done (&/T (&/T file-name line-num column-num) text))
(&/V $Yes (&/T (&/T (&/T file-name line-num column-num) text)
- (&/T (&/T file-name line-num column-num*) line)))))
+ (&/T (&/T file-name line-num column-num*) line)))))
(&/V $No (str "[Reader Error] Text failed: " text))))))
(def ^:private ^String +source-dir+ "input/")
diff --git a/src/lux/type.clj b/src/lux/type.clj
index e78b5616a..9f3adb036 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -235,10 +235,10 @@
(def DefData*
(All$ empty-env "lux;DefData'" ""
(Variant$ (&/|list
- ;; "lux;TypeD"
- Type
;; "lux;ValueD"
(Tuple$ (&/|list Type Unit))
+ ;; "lux;TypeD"
+ Type
;; "lux;MacroD"
(Bound$ "")
;; "lux;AliasD"
@@ -270,12 +270,18 @@
;; "lux;imports"
(App$ List Text)
;; "lux;tags"
- ;; (List (, Text (List Ident)))
+ ;; (List (, Text (, Int (List Ident) Type)))
(App$ List
(Tuple$ (&/|list Text
(Tuple$ (&/|list Int
- (App$ List
- Ident))))))
+ (App$ List Ident)
+ Type)))))
+ ;; "lux;types"
+ ;; (List (, Text (, (List Ident) Type)))
+ (App$ List
+ (Tuple$ (&/|list Text
+ (Tuple$ (&/|list (App$ List Ident)
+ Type)))))
))))
(def $Compiler
@@ -315,7 +321,7 @@
(defn bound? [id]
(fn [state]
- (if-let [type (->> state (&/get$ &/$types) (&/get$ &/$mappings) (&/|get id))]
+ (if-let [type (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) (&/|get id))]
(|case type
(&/$Some type*)
(return* state true)
@@ -326,7 +332,7 @@
(defn deref [id]
(fn [state]
- (if-let [type* (->> state (&/get$ &/$types) (&/get$ &/$mappings) (&/|get id))]
+ (if-let [type* (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) (&/|get id))]
(|case type*
(&/$Some type)
(return* state type)
@@ -337,26 +343,26 @@
(defn set-var [id type]
(fn [state]
- (if-let [tvar (->> state (&/get$ &/$types) (&/get$ &/$mappings) (&/|get id))]
+ (if-let [tvar (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) (&/|get id))]
(|case tvar
(&/$Some bound)
(fail* (str "[Type Error] Can't rebind type var: " id " | Current type: " (show-type bound)))
(&/$None)
- (return* (&/update$ &/$types (fn [ts] (&/update$ &/$mappings #(&/|put id (&/V &/$Some type) %)
- ts))
+ (return* (&/update$ &/$type-vars (fn [ts] (&/update$ &/$mappings #(&/|put id (&/V &/$Some type) %)
+ ts))
state)
nil))
- (fail* (str "[Type Error] <set-var> Unknown type-var: " id " | " (->> state (&/get$ &/$types) (&/get$ &/$mappings) &/|length))))))
+ (fail* (str "[Type Error] <set-var> Unknown type-var: " id " | " (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) &/|length))))))
;; [Exports]
;; Type vars
(def ^:private create-var
(fn [state]
- (let [id (->> state (&/get$ &/$types) (&/get$ &/$counter))]
- (return* (&/update$ &/$types #(->> %
- (&/update$ &/$counter inc)
- (&/update$ &/$mappings (fn [ms] (&/|put id (&/V &/$None nil) ms))))
+ (let [id (->> state (&/get$ &/$type-vars) (&/get$ &/$counter))]
+ (return* (&/update$ &/$type-vars #(->> %
+ (&/update$ &/$counter inc)
+ (&/update$ &/$mappings (fn [ms] (&/|put id (&/V &/$None nil) ms))))
state)
id))))
@@ -391,11 +397,11 @@
(|do [?type** (clean* id ?type*)]
(return (&/T ?id (&/V &/$Some ?type**)))))
))))
- (->> state (&/get$ &/$types) (&/get$ &/$mappings)))]
+ (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings)))]
(fn [state]
- (return* (&/update$ &/$types #(->> %
- (&/update$ &/$counter dec)
- (&/set$ &/$mappings (&/|remove id mappings*)))
+ (return* (&/update$ &/$type-vars #(->> %
+ (&/update$ &/$counter dec)
+ (&/set$ &/$mappings (&/|remove id mappings*)))
state)
nil)))
state))))
@@ -966,3 +972,13 @@
_
(fail (str "[Type Error] Type is not a variant: " (show-type type)))))
+
+(defn type-name [type]
+ "(-> Type (Lux Ident))"
+ (|case type
+ (&/$NamedT name _)
+ (return name)
+
+ _
+ (fail (str "[Type Error] Type is not named: " (show-type type)))
+ ))