diff options
author | Eduardo Julian | 2017-10-11 17:10:16 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-10-11 17:10:16 -0400 |
commit | 6608f998bca38022af2ebe4f7557f20b20f58acf (patch) | |
tree | b1c7a7bf6492a973756d23f2845802198087e5d9 /luxc/src | |
parent | ede56371f52b63b92cf0dc35a22ae243053268c3 (diff) |
- Eliminated the Anns and Ann-Value types, and now only using Code for definition annotations.
Diffstat (limited to '')
-rw-r--r-- | luxc/src/lux/analyser/lux.clj | 6 | ||||
-rw-r--r-- | luxc/src/lux/analyser/meta.clj | 29 | ||||
-rw-r--r-- | luxc/src/lux/analyser/module.clj | 26 | ||||
-rw-r--r-- | luxc/src/lux/base.clj | 12 | ||||
-rw-r--r-- | luxc/src/lux/compiler/cache.clj | 16 | ||||
-rw-r--r-- | luxc/src/lux/compiler/cache/ann.clj | 137 | ||||
-rw-r--r-- | luxc/src/lux/compiler/core.clj | 4 | ||||
-rw-r--r-- | luxc/src/lux/compiler/js/lux.clj | 8 | ||||
-rw-r--r-- | luxc/src/lux/compiler/jvm/lux.clj | 38 | ||||
-rw-r--r-- | luxc/src/lux/type.clj | 81 |
10 files changed, 181 insertions, 176 deletions
diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj index b2292d879..8dc13680d 100644 --- a/luxc/src/lux/analyser/lux.clj +++ b/luxc/src/lux/analyser/lux.clj @@ -377,7 +377,7 @@ ((&/fail-with-loc error) state))) ;; module-name &/get-module-name ;; :let [[r-prefix r-name] real-name - ;; _ (when (= "syntax:" r-name) + ;; _ (when (= "refer" r-name) ;; (->> (&/|map &/show-ast macro-expansion) ;; (&/|interpose "\n") ;; (&/fold str "") @@ -542,7 +542,7 @@ =value (&/without-repl-closure (&/with-scope ?name (&&/analyse-1+ analyse ?value))) - =meta (&&/analyse-1 analyse &type/Anns ?meta) + =meta (&&/analyse-1 analyse &type/Code ?meta) ==meta (eval! (optimize =meta)) _ (&&module/test-type module-name ?name ==meta (&&/expr-type* =value)) _ (&&module/test-macro module-name ?name ==meta (&&/expr-type* =value)) @@ -612,7 +612,7 @@ (defn analyse-module [analyse optimize eval! compile-module ?meta] (|do [_ &/ensure-statement - =anns (&&/analyse-1 analyse &type/Anns ?meta) + =anns (&&/analyse-1 analyse &type/Code ?meta) ==anns (eval! (optimize =anns)) module-name &/get-module-name _ (&&module/set-anns ==anns module-name) diff --git a/luxc/src/lux/analyser/meta.clj b/luxc/src/lux/analyser/meta.clj index 120bab1b0..1770372a9 100644 --- a/luxc/src/lux/analyser/meta.clj +++ b/luxc/src/lux/analyser/meta.clj @@ -14,20 +14,27 @@ (def ^:private tag-prefix "lux") ;; [Values] -(defn meta-get [ident dict] - "(-> Ident Anns (Maybe Ann-Value))" - (|case dict - (&/$Cons [k v] dict*) - (if (ident= k ident) - (&/$Some v) - (meta-get ident dict*)) +(defn meta-get [ident annotations] + "(-> Ident Code (Maybe Code))" + (|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*)) - (&/$Nil) - &/$None + _ + (recur dict*)) + + (&/$Nil) + &/$None)) _ - (assert false (println-str (&/adt->text ident) - (&/adt->text dict))))) + &/$None)) (do-template [<name> <tag-name>] (def <name> (&/T [tag-prefix <tag-name>])) diff --git a/luxc/src/lux/analyser/module.clj b/luxc/src/lux/analyser/module.clj index 0a7e336aa..8c5a2d286 100644 --- a/luxc/src/lux/analyser/module.clj +++ b/luxc/src/lux/analyser/module.clj @@ -25,7 +25,7 @@ "imports" "tags" "types" - "module-anns" + "module-annotations" "module-state"]) (defn ^:private new-module [hash] @@ -41,8 +41,8 @@ (&/|table) ;; "lux;types" (&/|table) - ;; module-anns - (&/|list) + ;; module-annotations + (&/T [(&/T ["" 0 0]) (&/$Record (&/|list))]) ;; "module-state" $Active] )) @@ -211,7 +211,7 @@ (if-let [module (->> state (&/get$ &/$modules) (&/|get module-name))] - (return* state (&/get$ $module-anns module)) + (return* state (&/get$ $module-annotations module)) ((&/fail-with-loc (str "[Analyser Error] Module does not exist: " module-name)) state)))) @@ -221,7 +221,7 @@ (&/update$ &/$modules (fn [ms] (&/|update module-name - #(&/set$ $module-anns anns %) + #(&/set$ $module-annotations anns %) ms)))) nil))) @@ -236,14 +236,14 @@ (|let [[?type ?meta ?value] $def] (if (.equals ^Object current-module module) (|case (&meta/meta-get &meta/alias-tag ?meta) - (&/$Some (&/$IdentA [?r-module ?r-name])) + (&/$Some [_ (&/$Symbol [?r-module ?r-name])]) ((find-def ?r-module ?r-name) state) _ (return* state (&/T [(&/T [module name]) $def]))) (|case (&meta/meta-get &meta/export?-tag ?meta) - (&/$Some (&/$BoolA true)) + (&/$Some [_ (&/$Bool true)]) (return* state (&/T [(&/T [module name]) $def])) _ @@ -396,7 +396,7 @@ (|let [[k _def-data] kv [_ ?def-meta _] _def-data] (|case (&meta/meta-get &meta/alias-tag ?def-meta) - (&/$Some (&/$IdentA [?r-module ?r-name])) + (&/$Some [_ (&/$Symbol [?r-module ?r-name])]) (&/T [k (str ?r-module ";" ?r-name) _def-data]) _ @@ -406,7 +406,7 @@ (do-template [<name> <type> <tag> <desc>] (defn <name> [module name meta type] (|case (&meta/meta-get <tag> meta) - (&/$Some (&/$BoolA true)) + (&/$Some [_ (&/$Bool true)]) (&/try-all% (&/|list (&type/check <type> type) (&/fail-with-loc (str "[Analyser Error] Cannot tag as lux;" <desc> "? if it's not a " <desc> ": " (str module ";" name))))) @@ -419,12 +419,12 @@ (defn fetch-imports [meta] (|case (&meta/meta-get &meta/imports-tag meta) - (&/$Some (&/$ListA _parts)) + (&/$Some [_ (&/$Tuple _parts)]) (&/map% (fn [_part] (|case _part - (&/$ListA (&/$Cons [(&/$TextA _module) - (&/$Cons [(&/$TextA _alias) - (&/$Nil)])])) + [_ (&/$Tuple (&/$Cons [[_ (&/$Text _module)] + (&/$Cons [[_ (&/$Text _alias)] + (&/$Nil)])]))] (return (&/T [_module _alias])) _ diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj index 172ade295..7207b2cca 100644 --- a/luxc/src/lux/base.clj +++ b/luxc/src/lux/base.clj @@ -215,18 +215,6 @@ ("AbstractMethodAnalysis" 1) ("NativeMethodAnalysis" 1)) -;; Meta-data -(defvariant - ("BoolA" 1) - ("NatA" 1) - ("IntA" 1) - ("DegA" 1) - ("FracA" 1) - ("TextA" 1) - ("IdentA" 1) - ("ListA" 1) - ("DictA" 1)) - ;; [Exports] (def ^:const value-field "_value") (def ^:const module-class-name "_") diff --git a/luxc/src/lux/compiler/cache.clj b/luxc/src/lux/compiler/cache.clj index c51691322..e017e08e2 100644 --- a/luxc/src/lux/compiler/cache.clj +++ b/luxc/src/lux/compiler/cache.clj @@ -83,17 +83,27 @@ (|do [[was-exported? =type] (&a-module/type-def module _type)] (&a-module/declare-tags module _tags was-exported? =type)))) +(defn make-tag [ident] + (&/T [(&/T ["" 0 0]) (&/$Tag ident)])) + +(defn make-symbol [ident] + (&/T [(&/T ["" 0 0]) (&/$Symbol ident)])) + +(defn make-record [ident] + (&/T [(&/T ["" 0 0]) (&/$Record ident)])) + (defn ^:private process-def-entry [load-def-value module ^String _def-entry] (let [parts (.split _def-entry &&core/datum-separator)] (case (alength parts) 2 (let [[_name _alias] parts [_ __module __name] (re-find #"^(.*);(.*)$" _alias) - def-anns (&/|list (&/T [&a-meta/alias-tag (&/$IdentA (&/T [__module __name]))]))] + def-anns (make-record (&/|list (&/T [(make-tag &a-meta/alias-tag) + (make-symbol (&/T [__module __name]))])))] (|do [def-type (&a-module/def-type __module __name) def-value (load-def-value __module __name)] (&a-module/define module _name def-type def-anns def-value))) 3 (let [[_name _type _anns] parts - def-anns (&&&ann/deserialize-anns _anns) + [def-anns _] (&&&ann/deserialize _anns) [def-type _] (&&&type/deserialize-type _type)] (|do [def-value (load-def-value module _name)] (&a-module/define module _name def-type def-anns def-value)))))) @@ -134,7 +144,7 @@ (contains? cache-table* _module))) imports) (let [tag-groups (parse-tag-groups _tags-section) - module-anns (&&&ann/deserialize-anns _module-anns-section) + [module-anns _] (&&&ann/deserialize _module-anns-section) def-entries (let [def-entries (vec (.split ^String _defs-section &&core/entry-separator))] (if (= [""] def-entries) &/$Nil diff --git a/luxc/src/lux/compiler/cache/ann.clj b/luxc/src/lux/compiler/cache/ann.clj index 6ee941bf8..4be70a611 100644 --- a/luxc/src/lux/compiler/cache/ann.clj +++ b/luxc/src/lux/compiler/cache/ann.clj @@ -10,95 +10,90 @@ (def ^:private nil-signal (->> 6 char str)) (def ^:private ident-separator ";") -(defn ^:private serialize-seq [serialize-ann params] +(defn ^:private serialize-seq [serialize params] (str (&/fold (fn [so-far param] - (str so-far cons-signal (serialize-ann param))) + (str so-far cons-signal (serialize param))) "" params) nil-signal)) -(defn ^:private serialize-text [value] - (str "T" value stop)) - (defn ^:private serialize-ident [ident] (|let [[module name] ident] - (str "@" module ident-separator name stop))) + (str module ident-separator name))) -(defn serialize-ann - "(-> Ann-Value Text)" +(defn serialize + "(-> Code Text)" [ann] (|case ann - (&/$BoolA value) + [_ (&/$Bool value)] (str "B" value stop) - (&/$NatA value) + [_ (&/$Nat value)] (str "N" value stop) - (&/$IntA value) + [_ (&/$Int value)] (str "I" value stop) - (&/$DegA value) + [_ (&/$Deg value)] (str "D" value stop) - (&/$FracA value) - (str "R" value stop) + [_ (&/$Frac value)] + (str "F" value stop) + + [_ (&/$Text value)] + (str "T" value stop) + + [_ (&/$Symbol ident)] + (str "@" (serialize-ident ident) stop) - (&/$TextA value) - (serialize-text value) + [_ (&/$Tag ident)] + (str "#" (serialize-ident ident) stop) - (&/$IdentA ident) - (serialize-ident ident) + [_ (&/$Form elems)] + (str "(" (serialize-seq serialize elems)) - (&/$ListA elems) - (str "L" (serialize-seq serialize-ann elems)) + [_ (&/$Tuple elems)] + (str "[" (serialize-seq serialize elems)) - (&/$DictA kvs) - (str "D" (serialize-seq (fn [kv] + [_ (&/$Record kvs)] + (str "{" (serialize-seq (fn [kv] (|let [[k v] kv] - (str (serialize-text k) - (serialize-ann v)))) + (str (serialize k) + (serialize v)))) kvs)) _ (assert false) )) -(defn serialize-anns - "(-> Anns Text)" - [anns] - (serialize-seq (fn [kv] - (|let [[k v] kv] - (str (serialize-ident k) - (serialize-ann v)))) - anns)) +(declare deserialize) -(declare deserialize-ann) +(def dummy-cursor + (&/T ["" 0 0])) (do-template [<name> <signal> <ctor> <parser>] (defn <name> [^String input] (when (.startsWith input <signal>) (let [[value* ^String input*] (.split (.substring input 1) stop 2)] - [(<ctor> (<parser> value*)) input*]))) - - ^:private deserialize-bool "B" &/$BoolA Boolean/parseBoolean - ^:private deserialize-nat "N" &/$NatA Long/parseLong - ^:private deserialize-int "I" &/$IntA Long/parseLong - ^:private deserialize-deg "D" &/$DegA Long/parseLong - ^:private deserialize-frac "R" &/$FracA Double/parseDouble - ^:private deserialize-text "T" &/$TextA identity + [(&/T [dummy-cursor (<ctor> (<parser> value*))]) input*]))) + + ^:private deserialize-bool "B" &/$Bool Boolean/parseBoolean + ^:private deserialize-nat "N" &/$Nat Long/parseLong + ^:private deserialize-int "I" &/$Int Long/parseLong + ^:private deserialize-deg "D" &/$Deg Long/parseLong + ^:private deserialize-frac "F" &/$Frac Double/parseDouble + ^:private deserialize-text "T" &/$Text identity ) -(defn ^:private deserialize-ident* [^String input] - (when (.startsWith input "@") - (let [[^String ident* ^String input*] (.split (.substring input 1) stop 2) - [_module _name] (.split ident* ident-separator 2)] - [(&/T [_module _name]) input*]))) +(do-template [<name> <marker> <tag>] + (defn <name> [^String input] + (when (.startsWith input <marker>) + (let [[^String ident* ^String input*] (.split (.substring input 1) stop 2) + [_module _name] (.split ident* ident-separator 2)] + [(&/T [dummy-cursor (<tag> (&/T [_module _name]))]) input*]))) -(defn ^:private deserialize-ident [^String input] - (when (.startsWith input "@") - (let [[^String ident* ^String input*] (.split (.substring input 1) stop 2) - [_module _name] (.split ident* ident-separator 2)] - [(&/$IdentA (&/T [_module _name])) input*]))) + ^:private deserialize-symbol "@" &/$Symbol + ^:private deserialize-tag "#" &/$Tag) (defn ^:private deserialize-seq [deserializer ^String input] (cond (.startsWith input nil-signal) @@ -110,29 +105,25 @@ [(&/$Cons head tail) input*])) )) -(do-template [<name> <deserialize-key>] - (defn <name> [input] - (when-let [[key input*] (<deserialize-key> input)] - (when-let [[ann input*] (deserialize-ann input*)] - [(&/T [key ann]) input*]))) - - ^:private deserialize-kv deserialize-text - ^:private deserialize-ann-entry deserialize-ident* - ) +(defn ^:private deserialize-kv [input] + (when-let [[key input*] (deserialize input)] + (when-let [[ann input*] (deserialize input*)] + [(&/T [key ann]) input*]))) (do-template [<name> <signal> <type> <deserializer>] (defn <name> [^String input] (when (.startsWith input <signal>) (when-let [[elems ^String input*] (deserialize-seq <deserializer> (.substring input 1))] - [(<type> elems) input*]))) + [(&/T [dummy-cursor (<type> elems)]) input*]))) - ^:private deserialize-list "L" &/$ListA deserialize-ann - ^:private deserialize-dict "D" &/$DictA deserialize-kv + ^:private deserialize-form "(" &/$Form deserialize + ^:private deserialize-tuple "[" &/$Tuple deserialize + ^:private deserialize-record "{" &/$Record deserialize-kv ) -(defn ^:private deserialize-ann - "(-> Text Anns)" +(defn deserialize + "(-> Text V[Code Text])" [input] (or (deserialize-bool input) (deserialize-nat input) @@ -140,13 +131,9 @@ (deserialize-deg input) (deserialize-frac input) (deserialize-text input) - (deserialize-ident input) - (deserialize-list input) - (deserialize-dict input) - (assert false "[Cache error] Cannot deserialize annocation."))) - -(defn deserialize-anns - "(-> Text Text)" - [^String input] - (let [[output _] (deserialize-seq deserialize-ann-entry input)] - output)) + (deserialize-symbol input) + (deserialize-tag input) + (deserialize-form input) + (deserialize-tuple input) + (deserialize-record input) + (assert false "[Cache Error] Cannot deserialize annocation."))) diff --git a/luxc/src/lux/compiler/core.clj b/luxc/src/lux/compiler/core.clj index a43a6ff48..3f8532e94 100644 --- a/luxc/src/lux/compiler/core.clj +++ b/luxc/src/lux/compiler/core.clj @@ -52,7 +52,7 @@ (&/|map (fn [_def] (|let [[?name ?alias [?def-type ?def-anns ?def-value]] _def] (if (= "" ?alias) - (str ?name datum-separator (&&&type/serialize-type ?def-type) datum-separator (&&&ann/serialize-anns ?def-anns)) + (str ?name datum-separator (&&&type/serialize-type ?def-type) datum-separator (&&&ann/serialize ?def-anns)) (str ?name datum-separator ?alias))))) (&/|interpose entry-separator) (&/fold str "")) @@ -75,7 +75,7 @@ (Long/toUnsignedString file-hash) import-entries tag-entries - (&&&ann/serialize-anns module-anns) + (&&&ann/serialize module-anns) def-entries) (&/|interpose section-separator) (&/fold str ""))]] diff --git a/luxc/src/lux/compiler/js/lux.clj b/luxc/src/lux/compiler/js/lux.clj index 0be8f1cae..6319f1b2b 100644 --- a/luxc/src/lux/compiler/js/lux.clj +++ b/luxc/src/lux/compiler/js/lux.clj @@ -317,7 +317,7 @@ (defn compile-def [compile ?name ?body def-meta] (|do [module-name &/get-module-name] (|case (&a-meta/meta-get &a-meta/alias-tag def-meta) - (&/$Some (&/$IdentA [r-module r-name])) + (&/$Some [_ (&/$Symbol [r-module r-name])]) (if (= 1 (&/|length def-meta)) (|do [def-value (&&/run-js! (&&/js-var-name r-module r-name)) def-type (&a-module/def-type r-module r-name) @@ -334,7 +334,7 @@ =body (compile ?body) :let [def-js (str "var " var-name " = " =body ";") is-type? (|case (&a-meta/meta-get &a-meta/type?-tag def-meta) - (&/$Some (&/$BoolA true)) + (&/$Some [_ (&/$Bool true)]) true _ @@ -345,7 +345,7 @@ _ (&/without-repl-closure (&a-module/define module-name ?name def-type def-meta def-value)) _ (|case (&/T [is-type? (&a-meta/meta-get &a-meta/tags-tag def-meta)]) - [true (&/$Some (&/$ListA tags*))] + [true (&/$Some [_ (&/$Tuple tags*)])] (|do [:let [was-exported? (|case (&a-meta/meta-get &a-meta/export?-tag def-meta) (&/$Some _) true @@ -354,7 +354,7 @@ false)] tags (&/map% (fn [tag*] (|case tag* - (&/$TextA tag) + [_ (&/$Text tag)] (return tag) _ diff --git a/luxc/src/lux/compiler/jvm/lux.clj b/luxc/src/lux/compiler/jvm/lux.clj index 99e55c3a0..b76a889b0 100644 --- a/luxc/src/lux/compiler/jvm/lux.clj +++ b/luxc/src/lux/compiler/jvm/lux.clj @@ -254,20 +254,22 @@ (|do [module-name &/get-module-name class-loader &/loader] (|case (&a-meta/meta-get &a-meta/alias-tag ?meta) - (&/$Some (&/$IdentA [r-module r-name])) - (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-meta ?meta - 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 def-type def-meta def-value))] - (return nil)) - (&/fail-with-loc (str "[Compilation Error] Aliases cannot contain meta-data: " module-name ";" ?name))) + (&/$Some [_ (&/$Symbol [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-meta ?meta + 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 def-type def-meta def-value))] + (return nil)) + (&/fail-with-loc (str "[Compilation Error] Aliases cannot contain meta-data: " module-name ";" ?name)))) (&/$Some _) - (&/fail-with-loc "[Compilation Error] Invalid syntax for lux;alias meta-data. Must be an Ident.") + (&/fail-with-loc "[Compilation Error] Invalid syntax for lux;alias meta-data. Must be a symbol.") _ (|case (de-ann ?body) @@ -301,7 +303,7 @@ :let [def-class (&&/load-class! class-loader (&host-generics/->class-name current-class)) def-type (&a/expr-type* ?body) is-type? (|case (&a-meta/meta-get &a-meta/type?-tag ?meta) - (&/$Some (&/$BoolA true)) + (&/$Some [_ (&/$Bool true)]) true _ @@ -315,7 +317,7 @@ _ (&/without-repl-closure (&a-module/define module-name ?name def-type def-meta def-value)) _ (|case (&/T [is-type? (&a-meta/meta-get &a-meta/tags-tag def-meta)]) - [true (&/$Some (&/$ListA tags*))] + [true (&/$Some [_ (&/$Tuple tags*)])] (|do [:let [was-exported? (|case (&a-meta/meta-get &a-meta/export?-tag def-meta) (&/$Some _) true @@ -324,7 +326,7 @@ false)] tags (&/map% (fn [tag*] (|case tag* - (&/$TextA tag) + [_ (&/$Text tag)] (return tag) _ @@ -370,7 +372,7 @@ :let [def-class (&&/load-class! class-loader (&host-generics/->class-name current-class)) def-type (&a/expr-type* ?body) is-type? (|case (&a-meta/meta-get &a-meta/type?-tag ?meta) - (&/$Some (&/$BoolA true)) + (&/$Some [_ (&/$Bool true)]) true _ @@ -384,7 +386,7 @@ _ (&/without-repl-closure (&a-module/define module-name ?name def-type def-meta def-value)) _ (|case (&/T [is-type? (&a-meta/meta-get &a-meta/tags-tag def-meta)]) - [true (&/$Some (&/$ListA tags*))] + [true (&/$Some [_ (&/$Tuple tags*)])] (|do [:let [was-exported? (|case (&a-meta/meta-get &a-meta/export?-tag def-meta) (&/$Some _) true @@ -393,7 +395,7 @@ false)] tags (&/map% (fn [tag*] (|case tag* - (&/$TextA tag) + [_ (&/$Text tag)] (return tag) _ diff --git a/luxc/src/lux/type.clj b/luxc/src/lux/type.clj index dd7a49610..6de9b7086 100644 --- a/luxc/src/lux/type.clj +++ b/luxc/src/lux/type.clj @@ -122,42 +122,53 @@ (&/$Product Ident Type))))))))))))) ))))) -(def Ann-Value - (&/$Named (&/T ["lux" "Ann-Value"]) - (let [Ann-Value (&/$Apply (&/$Bound 1) (&/$Bound 0))] - (&/$Apply &/$Void - (&/$UnivQ empty-env - (&/$Sum - ;; BoolA - Bool - (&/$Sum - ;; NatA - Nat - (&/$Sum - ;; IntA - Int - (&/$Sum - ;; DegA - Deg - (&/$Sum - ;; FracA - Frac - (&/$Sum - ;; TextA - Text - (&/$Sum - ;; IdentA - Ident - (&/$Sum - ;; ListA - (&/$Apply Ann-Value List) - ;; DictA - (&/$Apply (&/$Product Text Ann-Value) List))))))))) - ))))) +(def Cursor + (&/$Named (&/T ["lux" "Cursor"]) + (&/$Product Text (&/$Product Nat Nat)))) -(def Anns - (&/$Named (&/T ["lux" "Anns"]) - (&/$Apply (&/$Product Ident Ann-Value) List))) +(def Meta + (&/$Named (&/T ["lux" "Meta"]) + (&/$UnivQ empty-env + (&/$UnivQ empty-env + (&/$Product (&/$Bound 3) + (&/$Bound 1)))))) + +(def Code* + (&/$Named (&/T ["lux" "Code'"]) + (let [Code (&/$Apply (&/$Apply (&/$Bound 1) + (&/$Bound 0)) + (&/$Bound 1)) + Code-List (&/$Apply Code List)] + (&/$UnivQ empty-env + (&/$Sum ;; "lux;Bool" + Bool + (&/$Sum ;; "lux;Nat" + Nat + (&/$Sum ;; "lux;Int" + Int + (&/$Sum ;; "lux;Deg" + Deg + (&/$Sum ;; "lux;Frac" + Frac + (&/$Sum ;; "lux;Text" + Text + (&/$Sum ;; "lux;Symbol" + Ident + (&/$Sum ;; "lux;Tag" + Ident + (&/$Sum ;; "lux;Form" + Code-List + (&/$Sum ;; "lux;Tuple" + Code-List + ;; "lux;Record" + (&/$Apply (&/$Product Code Code) List) + )))))))))) + )))) + +(def Code + (&/$Named (&/T ["lux" "Code"]) + (let [w (&/$Apply Cursor Meta)] + (&/$Apply (&/$Apply w Code*) w)))) (def Macro) |