diff options
Diffstat (limited to '')
| -rw-r--r-- | src/lux/analyser.clj | 5 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 43 | ||||
| -rw-r--r-- | src/lux/analyser/module.clj | 97 | ||||
| -rw-r--r-- | src/lux/base.clj | 2 | ||||
| -rw-r--r-- | src/lux/compiler/host.clj | 8 | ||||
| -rw-r--r-- | src/lux/compiler/type.clj | 4 | ||||
| -rw-r--r-- | src/lux/host.clj | 7 | ||||
| -rw-r--r-- | src/lux/parser.clj | 4 | ||||
| -rw-r--r-- | src/lux/reader.clj | 14 | ||||
| -rw-r--r-- | src/lux/type.clj | 54 |
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))) + )) |