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 | |
| 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 | ||||
| -rw-r--r-- | stdlib/source/lux.lux | 2073 | ||||
| -rw-r--r-- | stdlib/source/lux/concurrency/actor.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/json.lux | 112 | ||||
| -rw-r--r-- | stdlib/source/lux/data/text/lexer.lux | 5 | ||||
| -rw-r--r-- | stdlib/source/lux/macro.lux | 168 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/syntax.lux | 86 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/syntax/common/reader.lux | 50 | ||||
| -rw-r--r-- | stdlib/source/lux/test.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/type/object.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/type/opaque.lux | 22 |
20 files changed, 1499 insertions, 1384 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) diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 480bc3468..3c1edac4b 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1,116 +1,172 @@ ## Basic types +(_lux_def dummy-cursor + (_lux_: (+4 (+0 "#Text" (+0)) (+4 (+0 "#Nat" (+0)) (+0 "#Nat" (+0)))) + ["" +0 +0]) + [["" +0 +0] + (+10 (+1 [[["" +0 +0] (+7 ["lux" "export?"])] + [["" +0 +0] (+0 true)]] + (+0)))]) + +## (type: (List a) +## #Nil +## (#Cons a (List a))) +(_lux_def List + (+12 ["lux" "List"] + (+9 (+0) + (+3 ## "lux;Nil" + (+2) + ## "lux;Cons" + (+4 (+6 +1) + (+11 (+6 +1) (+6 +0)))))) + [dummy-cursor + (+10 (+1 [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (+1 [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (+1 [[dummy-cursor (+7 ["lux" "tags"])] + [dummy-cursor (+9 (+1 [dummy-cursor (+5 "Nil")] (+1 [dummy-cursor (+5 "Cons")] (+0))))]] + (+1 [[dummy-cursor (+7 ["lux" "type-args"])] + [dummy-cursor (+9 (+1 [dummy-cursor (+5 "a")] (+0)))]] + (+1 [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "A potentially empty list of values.")]] + (+0)))))))]) + (_lux_def Bool (+12 ["lux" "Bool"] - (+0 "#Bool" (+0))) - (+1 [["lux" "type?"] (+0 true)] - (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+5 "Your standard, run-of-the-mill boolean values.")] - (+0))))) + (+0 "#Bool" #Nil)) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "Your standard, run-of-the-mill boolean values.")]] + #Nil))))]) (_lux_def Nat (+12 ["lux" "Nat"] - (+0 "#Nat" (+0))) - (+1 [["lux" "type?"] (+0 true)] - (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+5 "Natural numbers (unsigned integers). - - They start at zero (+0) and extend in the positive direction.")] - (+0))))) + (+0 "#Nat" #Nil)) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "Natural numbers (unsigned integers). + + They start at zero (+0) and extend in the positive direction.")]] + #Nil))))]) (_lux_def Int (+12 ["lux" "Int"] - (+0 "#Int" (+0))) - (+1 [["lux" "type?"] (+0 true)] - (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+5 "Your standard, run-of-the-mill integer numbers.")] - (+0))))) + (+0 "#Int" #Nil)) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "Your standard, run-of-the-mill integer numbers.")]] + #Nil))))]) (_lux_def Frac (+12 ["lux" "Frac"] - (+0 "#Frac" (+0))) - (+1 [["lux" "type?"] (+0 true)] - (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+5 "Your standard, run-of-the-mill floating-point numbers.")] - (+0))))) + (+0 "#Frac" #Nil)) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "Your standard, run-of-the-mill floating-point (fractional) numbers.")]] + #Nil))))]) (_lux_def Deg (+12 ["lux" "Deg"] - (+0 "#Deg" (+0))) - (+1 [["lux" "type?"] (+0 true)] - (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+5 "Fractional numbers that live in the interval [0,1). - - Useful for probability, and other domains that work within that interval.")] - (+0))))) + (+0 "#Deg" #Nil)) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "Fractional numbers that live in the interval [0,1). + + Useful for probability, and other domains that work within that interval.")]] + #Nil))))]) (_lux_def Text (+12 ["lux" "Text"] - (+0 "#Text" (+0))) - (+1 [["lux" "type?"] (+0 true)] - (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+5 "Your standard, run-of-the-mill string values.")] - (+0))))) + (+0 "#Text" #Nil)) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "Your standard, run-of-the-mill string values.")]] + #Nil))))]) (_lux_def Void (+12 ["lux" "Void"] (+1)) - (+1 [["lux" "type?"] (+0 true)] - (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+5 "An unusual type that possesses no value, and thus cannot be instantiated.")] - (+0))))) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "An unusual type that possesses no value, and thus cannot be instantiated.")]] + #Nil))))]) (_lux_def Unit (+12 ["lux" "Unit"] (+2)) - (+1 [["lux" "type?"] (+0 true)] - (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+5 "An unusual type that only possesses a single value: []")] - (+0))))) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "An unusual type that only possesses a single value: []")]] + #Nil))))]) (_lux_def Ident (+12 ["lux" "Ident"] (+4 Text Text)) - (+1 [["lux" "type?"] (+0 true)] - (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+5 "An identifier. + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "An identifier. - It is used as part of Lux syntax to represent symbols and tags.")] - (+0))))) - -## (type: (List a) -## #Nil -## (#Cons a (List a))) -(_lux_def List - (+12 ["lux" "List"] - (+9 (+0) - (+3 ## "lux;Nil" - (+2) - ## "lux;Cons" - (+4 (+6 +1) - (+11 (+6 +1) (+6 +0)))))) - (+1 [["lux" "type?"] (+0 true)] - (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "tags"] (+7 (+1 (+5 "Nil") (+1 (+5 "Cons") (+0))))] - (+1 [["lux" "type-args"] (+7 (+1 (+5 "a") (+0)))] - (+1 [["lux" "doc"] (+5 "A potentially empty list of values.")] - (+0))))))) + It is used as part of Lux syntax to represent symbols and tags.")]] + #Nil))))]) ## (type: (Maybe a) ## #None ## (#Some a)) (_lux_def Maybe (+12 ["lux" "Maybe"] - (+9 (+0) + (+9 #Nil (+3 ## "lux;None" (+2) ## "lux;Some" (+6 +1)))) - (#Cons [["lux" "type?"] (+0 true)] - (#Cons [["lux" "export?"] (+0 true)] - (#Cons [["lux" "tags"] (+7 (#Cons (+5 "None") (#Cons (+5 "Some") #Nil)))] - (#Cons [["lux" "type-args"] (+7 (#Cons (+5 "a") #Nil))] - (#Cons [["lux" "doc"] (+5 "A potentially missing value.")] - #Nil)))))) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "tags"])] + [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "None")] (#Cons [dummy-cursor (+5 "Some")] #Nil)))]] + (#Cons [[dummy-cursor (+7 ["lux" "type-args"])] + [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "a")] #Nil))]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "A potentially missing value.")]] + #Nil))))))]) ## (type: #rec Type ## (#Host Text (List Type)) @@ -132,23 +188,23 @@ (_lux_case (+11 (+6 +1) (+6 +0)) Type (_lux_case (+11 Type List) - TypeList + Type-List (_lux_case (+4 Type Type) - TypePair + Type-Pair (+11 Void (+9 #Nil (+3 ## "lux;Host" - (+4 Text TypeList) + (+4 Text Type-List) (+3 ## "lux;Void" (+2) (+3 ## "lux;Unit" (+2) (+3 ## "lux;Sum" - TypePair + Type-Pair (+3 ## "lux;Product" - TypePair + Type-Pair (+3 ## "lux;Function" - TypePair + Type-Pair (+3 ## "lux;Bound" Nat (+3 ## "lux;Var" @@ -156,158 +212,70 @@ (+3 ## "lux;Ex" Nat (+3 ## "lux;UnivQ" - (+4 TypeList Type) + (+4 Type-List Type) (+3 ## "lux;ExQ" - (+4 TypeList Type) + (+4 Type-List Type) (+3 ## "lux;App" - TypePair + Type-Pair ## "lux;Named" (+4 Ident Type))))))))))))))))))) - (#Cons [["lux" "type?"] (+0 true)] - (#Cons [["lux" "export?"] (+0 true)] - (#Cons [["lux" "tags"] (+7 (#Cons (+5 "Host") - (#Cons (+5 "Void") - (#Cons (+5 "Unit") - (#Cons (+5 "Sum") - (#Cons (+5 "Product") - (#Cons (+5 "Function") - (#Cons (+5 "Bound") - (#Cons (+5 "Var") - (#Cons (+5 "Ex") - (#Cons (+5 "UnivQ") - (#Cons (+5 "ExQ") - (#Cons (+5 "Apply") - (#Cons (+5 "Named") - #Nil))))))))))))))] - (#Cons [["lux" "doc"] (+5 "This type represents the data-structures that are used to specify types themselves.")] - (#Cons [["lux" "type-rec?"] (+0 true)] - #Nil)))))) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "tags"])] + [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "Host")] + (#Cons [dummy-cursor (+5 "Void")] + (#Cons [dummy-cursor (+5 "Unit")] + (#Cons [dummy-cursor (+5 "Sum")] + (#Cons [dummy-cursor (+5 "Product")] + (#Cons [dummy-cursor (+5 "Function")] + (#Cons [dummy-cursor (+5 "Bound")] + (#Cons [dummy-cursor (+5 "Var")] + (#Cons [dummy-cursor (+5 "Ex")] + (#Cons [dummy-cursor (+5 "UnivQ")] + (#Cons [dummy-cursor (+5 "ExQ")] + (#Cons [dummy-cursor (+5 "Apply")] + (#Cons [dummy-cursor (+5 "Named")] + #Nil))))))))))))))]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "This type represents the data-structures that are used to specify types themselves.")]] + (#Cons [[dummy-cursor (+7 ["lux" "type-rec?"])] + [dummy-cursor (+0 true)]] + #Nil))))))]) ## (type: Top ## (Ex [a] a)) (_lux_def Top (#Named ["lux" "Top"] (#ExQ #Nil (#Bound +1))) - (#Cons [["lux" "type?"] (+0 true)] - (#Cons [["lux" "export?"] (+0 true)] - (#Cons [["lux" "doc"] (+5 "The type of things whose type does not matter. + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "The type of things whose type does not matter. - It can be used to write functions or data-structures that can take, or return, anything.")] - #Nil)))) + It can be used to write functions or data-structures that can take, or return, anything.")]] + #Nil))))]) ## (type: Bottom ## (All [a] a)) (_lux_def Bottom (#Named ["lux" "Bottom"] (#UnivQ #Nil (#Bound +1))) - (#Cons [["lux" "type?"] (+0 true)] - (#Cons [["lux" "export?"] (+0 true)] - (#Cons [["lux" "doc"] (+5 "The type of things whose type is unknown or undefined. - - Useful for expressions that cause errors or other \"extraordinary\" conditions.")] - #Nil)))) - -## (type: #rec Ann-Value -## (#BoolA Bool) -## (#NatA Nat) -## (#IntA Int) -## (#DegA Deg) -## (#FracA Frac) -## (#TextA Text) -## (#IdentA Ident) -## (#ListA (List Ann-Value)) -## (#DictA (List [Text Ann-Value]))) -(_lux_def Ann-Value - (#Named ["lux" "Ann-Value"] - (_lux_case (#Apply (#Bound +1) (#Bound +0)) - Ann-Value - (#Apply Void - (#UnivQ #Nil - (#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))))))))) - )) - )) - (#Cons [["lux" "type?"] (+0 true)] - (#Cons [["lux" "export?"] (+0 true)] - (#Cons [["lux" "tags"] (+7 (#Cons (+5 "BoolA") - (#Cons (+5 "NatA") - (#Cons (+5 "IntA") - (#Cons (+5 "DegA") - (#Cons (+5 "FracA") - (#Cons (+5 "TextA") - (#Cons (+5 "IdentA") - (#Cons (+5 "ListA") - (#Cons (+5 "DictA") - #Nil))))))))))] - (#Cons [["lux" "type-rec?"] (+0 true)] - (#Cons [["lux" "doc"] (+5 "The value of an individual annotation.")] - #Nil)))))) - -## (type: Anns -## (List [Ident Ann-Value])) -(_lux_def Anns - (#Named ["lux" "Anns"] - (#Apply (#Product Ident Ann-Value) List)) - (#Cons [["lux" "type?"] (#BoolA true)] - (#Cons [["lux" "export?"] (#BoolA true)] - (#Cons [["lux" "doc"] (#TextA "A set of annotations associated with a definition.")] - #Nil)))) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "The type of things whose type is unknown or undefined. -(_lux_def default-def-meta-exported - (_lux_: Anns - (#Cons [["lux" "type?"] (#BoolA true)] - (#Cons [["lux" "export?"] (#BoolA true)] - #Nil))) - #Nil) - -(_lux_def default-def-meta-unexported - (_lux_: Anns - (#Cons [["lux" "type?"] (#BoolA true)] - #Nil)) - #Nil) - -## (type: Def -## [Type Anns Top]) -(_lux_def Def - (#Named ["lux" "Def"] - (#Product Type (#Product Anns Top))) - (#Cons [["lux" "doc"] (#TextA "Represents all the data associated with a definition: its type, its annotations, and its value.")] - default-def-meta-exported)) - -## (type: (Bindings k v) -## {#counter Nat -## #mappings (List [k v])}) -(_lux_def Bindings - (#Named ["lux" "Bindings"] - (#UnivQ #Nil - (#UnivQ #Nil - (#Product ## "lux;counter" - Nat - ## "lux;mappings" - (#Apply (#Product (#Bound +3) - (#Bound +1)) - List))))) - (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "counter") - (#Cons (#TextA "mappings") - #Nil)))] - (#Cons [["lux" "type-args"] (#ListA (#Cons (#TextA "k") (#Cons (#TextA "v") #;Nil)))] - default-def-meta-exported))) + Useful for expressions that cause errors or other \"extraordinary\" conditions.")]] + #Nil))))]) ## (type: Cursor ## {#module Text @@ -316,12 +284,19 @@ (_lux_def Cursor (#Named ["lux" "Cursor"] (#Product Text (#Product Nat Nat))) - (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "module") - (#Cons (#TextA "line") - (#Cons (#TextA "column") - #Nil))))] - (#Cons [["lux" "doc"] (#TextA "Cursors are for specifying the location of Code nodes in Lux files during compilation.")] - default-def-meta-exported))) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "tags"])] + [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "module")] + (#Cons [dummy-cursor (+5 "line")] + (#Cons [dummy-cursor (+5 "column")] + #Nil))))]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "Cursors are for specifying the location of Code nodes in Lux files during compilation.")]] + (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + #Nil)))))]) ## (type: (Meta m v) ## {#meta m @@ -332,48 +307,20 @@ (#UnivQ #Nil (#Product (#Bound +3) (#Bound +1))))) - (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "meta") - (#Cons (#TextA "datum") - #Nil)))] - (#Cons [["lux" "doc"] (#TextA "The type of things that can have meta-data of arbitrary types.")] - (#Cons [["lux" "type-args"] (#ListA (#Cons (#TextA "m") (#Cons (#TextA "v") #;Nil)))] - default-def-meta-exported)))) - -## (type: #export Ref -## (#Local Nat) -## (#Captured Nat)) -(_lux_def Ref - (#Named ["lux" "Ref"] - (#Sum ## Local - Nat - ## Captured - Nat)) - (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Local") - (#Cons (#TextA "Captured") - #Nil)))] - default-def-meta-exported)) - -## (type: Scope -## {#name (List Text) -## #inner Nat -## #locals (Bindings Text [Type Nat]) -## #captured (Bindings Text [Type Ref])}) -(_lux_def Scope - (#Named ["lux" "Scope"] - (#Product ## name - (#Apply Text List) - (#Product ## inner - Nat - (#Product ## locals - (#Apply (#Product Type Nat) (#Apply Text Bindings)) - ## captured - (#Apply (#Product Type Ref) (#Apply Text Bindings)))))) - (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "name") - (#Cons (#TextA "inner") - (#Cons (#TextA "locals") - (#Cons (#TextA "captured") - #Nil)))))] - default-def-meta-exported)) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "tags"])] + [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "meta")] + (#Cons [dummy-cursor (+5 "datum")] + #Nil)))]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "The type of things that can have meta-data of arbitrary types.")]] + (#Cons [[dummy-cursor (+7 ["lux" "type-args"])] + [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "m")] (#Cons [dummy-cursor (+5 "v")] #;Nil)))]] + (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + #Nil))))))]) ## (type: (Code' w) ## (#Bool Bool) @@ -420,20 +367,27 @@ (#Apply (#Product Code Code) List) )))))))))) )))) - (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Bool") - (#Cons (#TextA "Nat") - (#Cons (#TextA "Int") - (#Cons (#TextA "Deg") - (#Cons (#TextA "Frac") - (#Cons (#TextA "Text") - (#Cons (#TextA "Symbol") - (#Cons (#TextA "Tag") - (#Cons (#TextA "Form") - (#Cons (#TextA "Tuple") - (#Cons (#TextA "Record") - #Nil))))))))))))] - (#Cons [["lux" "type-args"] (#ListA (#Cons (#TextA "w") #;Nil))] - default-def-meta-exported))) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "tags"])] + [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "Bool")] + (#Cons [dummy-cursor (+5 "Nat")] + (#Cons [dummy-cursor (+5 "Int")] + (#Cons [dummy-cursor (+5 "Deg")] + (#Cons [dummy-cursor (+5 "Frac")] + (#Cons [dummy-cursor (+5 "Text")] + (#Cons [dummy-cursor (+5 "Symbol")] + (#Cons [dummy-cursor (+5 "Tag")] + (#Cons [dummy-cursor (+5 "Form")] + (#Cons [dummy-cursor (+5 "Tuple")] + (#Cons [dummy-cursor (+5 "Record")] + #Nil))))))))))))]] + (#Cons [[dummy-cursor (+7 ["lux" "type-args"])] + [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "w")] #;Nil))]] + (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + #Nil)))))]) ## (type: Code ## (Meta Cursor (Code' (Meta Cursor)))) @@ -442,12 +396,157 @@ (_lux_case (#Apply Cursor Meta) w (#Apply (#Apply w Code') w))) - (#Cons [["lux" "doc"] (#TextA "The type of Code nodes for Lux syntax.")] - default-def-meta-exported)) + [dummy-cursor + (#Record (#Cons [[dummy-cursor (#Tag ["lux" "doc"])] + [dummy-cursor (#Text "The type of Code nodes for Lux syntax.")]] + (#Cons [[dummy-cursor (#Tag ["lux" "type?"])] + [dummy-cursor (#Bool true)]] + (#Cons [[dummy-cursor (#Tag ["lux" "export?"])] + [dummy-cursor (#Bool true)]] + #Nil))))]) + +(_lux_def _meta + (_lux_: (#Function (#Apply (#Apply Cursor Meta) + Code') + Code) + (_lux_function _ data + [dummy-cursor data])) + [dummy-cursor (#Record #Nil)]) + +(_lux_def bool$ + (_lux_: (#Function Bool Code) + (_lux_function _ value (_meta (#Bool value)))) + [dummy-cursor (#Record #Nil)]) + +(_lux_def nat$ + (_lux_: (#Function Nat Code) + (_lux_function _ value (_meta (#Nat value)))) + [dummy-cursor (#Record #Nil)]) + +(_lux_def int$ + (_lux_: (#Function Int Code) + (_lux_function _ value (_meta (#Int value)))) + [dummy-cursor (#Record #Nil)]) + +(_lux_def deg$ + (_lux_: (#Function Deg Code) + (_lux_function _ value (_meta (#Deg value)))) + [dummy-cursor (#Record #Nil)]) + +(_lux_def frac$ + (_lux_: (#Function Frac Code) + (_lux_function _ value (_meta (#Frac value)))) + [dummy-cursor (#Record #Nil)]) + +(_lux_def text$ + (_lux_: (#Function Text Code) + (_lux_function _ text (_meta (#Text text)))) + [dummy-cursor (#Record #Nil)]) + +(_lux_def symbol$ + (_lux_: (#Function Ident Code) + (_lux_function _ ident (_meta (#Symbol ident)))) + [dummy-cursor (#Record #Nil)]) + +(_lux_def tag$ + (_lux_: (#Function Ident Code) + (_lux_function _ ident (_meta (#Tag ident)))) + [dummy-cursor (#Record #Nil)]) + +(_lux_def form$ + (_lux_: (#Function (#Apply Code List) Code) + (_lux_function _ tokens (_meta (#Form tokens)))) + [dummy-cursor (#Record #Nil)]) + +(_lux_def tuple$ + (_lux_: (#Function (#Apply Code List) Code) + (_lux_function _ tokens (_meta (#Tuple tokens)))) + [dummy-cursor (#Record #Nil)]) + +(_lux_def record$ + (_lux_: (#Function (#Apply (#Product Code Code) List) Code) + (_lux_function _ tokens (_meta (#Record tokens)))) + [dummy-cursor (#Record #Nil)]) + +(_lux_def default-def-meta-exported + (_lux_: (#Apply (#Product Code Code) List) + (#Cons [(tag$ ["lux" "type?"]) + (bool$ true)] + (#Cons [(tag$ ["lux" "export?"]) + (bool$ true)] + #Nil))) + (record$ #Nil)) + +(_lux_def default-def-meta-unexported + (_lux_: (#Apply (#Product Code Code) List) + (#Cons [(tag$ ["lux" "type?"]) + (bool$ true)] + #Nil)) + (record$ #Nil)) + +## (type: Def +## [Type Code Top]) +(_lux_def Def + (#Named ["lux" "Def"] + (#Product Type (#Product Code Top))) + (record$ (#Cons [(tag$ ["lux" "doc"]) + (text$ "Represents all the data associated with a definition: its type, its annotations, and its value.")] + default-def-meta-exported))) + +## (type: (Bindings k v) +## {#counter Nat +## #mappings (List [k v])}) +(_lux_def Bindings + (#Named ["lux" "Bindings"] + (#UnivQ #Nil + (#UnivQ #Nil + (#Product ## "lux;counter" + Nat + ## "lux;mappings" + (#Apply (#Product (#Bound +3) + (#Bound +1)) + List))))) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "counter") (#Cons (text$ "mappings") #Nil)))] + (#Cons [(tag$ ["lux" "type-args"]) + (tuple$ (#Cons (text$ "k") (#Cons (text$ "v") #;Nil)))] + default-def-meta-exported)))) + +## (type: #export Ref +## (#Local Nat) +## (#Captured Nat)) +(_lux_def Ref + (#Named ["lux" "Ref"] + (#Sum ## Local + Nat + ## Captured + Nat)) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "Local") (#Cons (text$ "Captured") #Nil)))] + default-def-meta-exported))) + +## (type: Scope +## {#name (List Text) +## #inner Nat +## #locals (Bindings Text [Type Nat]) +## #captured (Bindings Text [Type Ref])}) +(_lux_def Scope + (#Named ["lux" "Scope"] + (#Product ## name + (#Apply Text List) + (#Product ## inner + Nat + (#Product ## locals + (#Apply (#Product Type Nat) (#Apply Text Bindings)) + ## captured + (#Apply (#Product Type Ref) (#Apply Text Bindings)))))) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "name") (#Cons (text$ "inner") (#Cons (text$ "locals") (#Cons (text$ "captured") #Nil)))))] + default-def-meta-exported))) (_lux_def Code-List (#Apply Code List) - default-def-meta-unexported) + (record$ default-def-meta-unexported)) ## (type: (Either l r) ## (#Left l) @@ -460,19 +559,20 @@ (#Bound +3) ## "lux;Right" (#Bound +1))))) - (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Left") - (#Cons (#TextA "Right") - #Nil)))] - (#Cons [["lux" "type-args"] (#ListA (#Cons (#TextA "l") (#Cons (#TextA "r") #;Nil)))] - (#Cons [["lux" "doc"] (#TextA "A choice between two values of different types.")] - default-def-meta-exported)))) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "Left") (#Cons (text$ "Right") #Nil)))] + (#Cons [(tag$ ["lux" "type-args"]) + (tuple$ (#Cons (text$ "l") (#Cons (text$ "r") #;Nil)))] + (#Cons [(tag$ ["lux" "doc"]) + (text$ "A choice between two values of different types.")] + default-def-meta-exported))))) ## (type: Source ## [Cursor Text]) (_lux_def Source (#Named ["lux" "Source"] (#Product Cursor Text)) - default-def-meta-exported) + (record$ default-def-meta-exported)) ## (type: Module-State ## #Active @@ -488,11 +588,9 @@ Unit ## #Cached Unit))) - (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Active") - (#Cons (#TextA "Compiled") - (#Cons (#TextA "Cached") - #Nil))))] - default-def-meta-exported)) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "Active") (#Cons (text$ "Compiled") (#Cons (text$ "Cached") #Nil))))] + default-def-meta-exported))) ## (type: Module ## {#module-hash Nat @@ -526,21 +624,23 @@ (#Product Bool Type))) List) - (#Product ## "lux;module-anns" - Anns + (#Product ## "lux;module-annotations" + Code Module-State)) )))))) - (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "module-hash") - (#Cons (#TextA "module-aliases") - (#Cons (#TextA "defs") - (#Cons (#TextA "imports") - (#Cons (#TextA "tags") - (#Cons (#TextA "types") - (#Cons (#TextA "module-anns") - (#Cons (#TextA "module-state") - #Nil)))))))))] - (#Cons [["lux" "doc"] (#TextA "All the information contained within a Lux module.")] - default-def-meta-exported))) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "module-hash") + (#Cons (text$ "module-aliases") + (#Cons (text$ "defs") + (#Cons (text$ "imports") + (#Cons (text$ "tags") + (#Cons (text$ "types") + (#Cons (text$ "module-annotations") + (#Cons (text$ "module-state") + #Nil)))))))))] + (#Cons [(tag$ ["lux" "doc"]) + (text$ "All the information contained within a Lux module.")] + default-def-meta-exported)))) ## (type: Type-Context ## {#ex-counter Nat @@ -555,11 +655,12 @@ ## var-bindings (#Apply (#Product Nat (#Apply Type Maybe)) List)))) - (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "ex-counter") - (#Cons (#TextA "var-counter") - (#Cons (#TextA "var-bindings") - #Nil))))] - default-def-meta-exported)) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "ex-counter") + (#Cons (text$ "var-counter") + (#Cons (text$ "var-bindings") + #Nil))))] + default-def-meta-exported))) ## (type: Compiler-Mode ## #Build @@ -573,12 +674,14 @@ #Unit ## REPL #Unit))) - (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Build") - (#Cons (#TextA "Eval") - (#Cons (#TextA "REPL") - #Nil))))] - (#Cons [["lux" "doc"] (#TextA "A sign that shows the conditions under which the compiler is running.")] - default-def-meta-exported))) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "Build") + (#Cons (text$ "Eval") + (#Cons (text$ "REPL") + #Nil))))] + (#Cons [(tag$ ["lux" "doc"]) + (text$ "A sign that shows the conditions under which the compiler is running.")] + default-def-meta-exported)))) ## (type: Compiler-Info ## {#compiler-name Text @@ -594,12 +697,14 @@ Text ## compiler-mode Compiler-Mode))) - (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "compiler-name") - (#Cons (#TextA "compiler-version") - (#Cons (#TextA "compiler-mode") - #Nil))))] - (#Cons [["lux" "doc"] (#TextA "Information about the current version and type of compiler that is running.")] - default-def-meta-exported))) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "compiler-name") + (#Cons (text$ "compiler-version") + (#Cons (text$ "compiler-mode") + #Nil))))] + (#Cons [(tag$ ["lux" "doc"]) + (text$ "Information about the current version and type of compiler that is running.")] + default-def-meta-exported)))) ## (type: Compiler ## {#info Compiler-Info @@ -634,23 +739,25 @@ (#Apply Nat List) ## "lux;host" Void)))))))))) - (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "info") - (#Cons (#TextA "source") - (#Cons (#TextA "cursor") - (#Cons (#TextA "modules") - (#Cons (#TextA "scopes") - (#Cons (#TextA "type-context") - (#Cons (#TextA "expected") - (#Cons (#TextA "seed") - (#Cons (#TextA "scope-type-vars") - (#Cons (#TextA "host") - #Nil)))))))))))] - (#Cons [["lux" "doc"] (#TextA "Represents the state of the Lux compiler during a run. - - It is provided to macros during their invocation, so they can access compiler data. - - Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")] - default-def-meta-exported))) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "info") + (#Cons (text$ "source") + (#Cons (text$ "cursor") + (#Cons (text$ "modules") + (#Cons (text$ "scopes") + (#Cons (text$ "type-context") + (#Cons (text$ "expected") + (#Cons (text$ "seed") + (#Cons (text$ "scope-type-vars") + (#Cons (text$ "host") + #Nil)))))))))))] + (#Cons [(tag$ ["lux" "doc"]) + (text$ "Represents the state of the Lux compiler during a run. + + It is provided to macros during their invocation, so they can access compiler data. + + Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")] + default-def-meta-exported)))) ## (type: (Lux a) ## (-> Compiler (Either Text [Compiler a]))) @@ -660,34 +767,24 @@ (#Function Compiler (#Apply (#Product Compiler (#Bound +1)) (#Apply Text Either))))) - (#Cons [["lux" "doc"] (#TextA "Computations that can have access to the state of the compiler. + (record$ (#Cons [(tag$ ["lux" "doc"]) + (text$ "Computations that can have access to the state of the compiler. - These computations may fail, or modify the state of the compiler.")] - (#Cons [["lux" "type-args"] (#ListA (#Cons (#TextA "a") #;Nil))] - default-def-meta-exported))) + These computations may fail, or modify the state of the compiler.")] + (#Cons [(tag$ ["lux" "type-args"]) + (tuple$ (#Cons (text$ "a") #;Nil))] + default-def-meta-exported)))) ## (type: Macro ## (-> (List Code) (Lux (List Code)))) (_lux_def Macro (#Named ["lux" "Macro"] (#Function Code-List (#Apply Code-List Lux))) - (#Cons [["lux" "doc"] (#TextA "Functions that run at compile-time and allow you to transform and extend the language in powerful ways.")] - default-def-meta-exported)) + (record$ (#Cons [(tag$ ["lux" "doc"]) + (text$ "Functions that run at compile-time and allow you to transform and extend the language in powerful ways.")] + default-def-meta-exported))) ## Base functions & macros -(_lux_def dummy-cursor - (_lux_: Cursor ["" +0 +0]) - (#Cons [["lux" "export?"] (#BoolA true)] - #Nil)) - -(_lux_def _meta - (_lux_: (#Function (#Apply (#Apply Cursor Meta) - Code') - Code) - (_lux_function _ data - [dummy-cursor data])) - #Nil) - (_lux_def return (_lux_: (#UnivQ #Nil (#Function (#Bound +1) @@ -698,7 +795,7 @@ (_lux_function _ val (_lux_function _ state (#Right state val)))) - #Nil) + (record$ #Nil)) (_lux_def fail (_lux_: (#UnivQ #Nil @@ -710,68 +807,14 @@ (_lux_function _ msg (_lux_function _ state (#Left msg)))) - #Nil) - -(_lux_def bool$ - (_lux_: (#Function Bool Code) - (_lux_function _ value (_meta (#Bool value)))) - #Nil) - -(_lux_def nat$ - (_lux_: (#Function Nat Code) - (_lux_function _ value (_meta (#Nat value)))) - #Nil) - -(_lux_def int$ - (_lux_: (#Function Int Code) - (_lux_function _ value (_meta (#Int value)))) - #Nil) - -(_lux_def deg$ - (_lux_: (#Function Deg Code) - (_lux_function _ value (_meta (#Deg value)))) - #Nil) - -(_lux_def frac$ - (_lux_: (#Function Frac Code) - (_lux_function _ value (_meta (#Frac value)))) - #Nil) - -(_lux_def text$ - (_lux_: (#Function Text Code) - (_lux_function _ text (_meta (#Text text)))) - #Nil) - -(_lux_def symbol$ - (_lux_: (#Function Ident Code) - (_lux_function _ ident (_meta (#Symbol ident)))) - #Nil) - -(_lux_def tag$ - (_lux_: (#Function Ident Code) - (_lux_function _ ident (_meta (#Tag ident)))) - #Nil) - -(_lux_def form$ - (_lux_: (#Function (#Apply Code List) Code) - (_lux_function _ tokens (_meta (#Form tokens)))) - #Nil) - -(_lux_def tuple$ - (_lux_: (#Function (#Apply Code List) Code) - (_lux_function _ tokens (_meta (#Tuple tokens)))) - #Nil) - -(_lux_def record$ - (_lux_: (#Function (#Apply (#Product Code Code) List) Code) - (_lux_function _ tokens (_meta (#Record tokens)))) - #Nil) + (record$ #Nil)) (_lux_def default-macro-meta - (_lux_: Anns - (#Cons [["lux" "macro?"] (#BoolA true)] + (_lux_: (#Apply (#Product Code Code) List) + (#Cons [(tag$ ["lux" "macro?"]) + (bool$ true)] #Nil)) - #Nil) + (record$ #Nil)) (_lux_def let'' (_lux_: Macro @@ -784,7 +827,7 @@ _ (fail "Wrong syntax for let''")))) - default-macro-meta) + (record$ default-macro-meta)) (_lux_def function'' (_lux_: Macro @@ -822,34 +865,44 @@ _ (fail "Wrong syntax for function''")))) - default-macro-meta) + (record$ default-macro-meta)) + +(_lux_def cursor-code + (_lux_: Code + (tuple$ (#Cons (text$ "") (#Cons (nat$ +0) (#Cons (nat$ +0) #Nil))))) + (record$ #Nil)) + +(_lux_def meta-code + (_lux_: (#Function Ident (#Function Code Code)) + (_lux_function _ tag + (_lux_function _ value + (tuple$ (#Cons cursor-code + (#Cons (form$ (#Cons (tag$ tag) (#Cons value #Nil))) + #Nil)))))) + (record$ #Nil)) + +(_lux_def flag-meta + (_lux_: (#Function Text Code) + (_lux_function _ tag + (tuple$ (#Cons [(meta-code ["lux" "Tag"] (tuple$ (#Cons (text$ "lux") (#Cons (text$ tag) #Nil)))) + (#Cons [(meta-code ["lux" "Bool"] (bool$ true)) + #Nil])])))) + (record$ #Nil)) (_lux_def export?-meta (_lux_: Code - (tuple$ (#Cons [(tuple$ (#Cons [(text$ "lux") (#Cons [(text$ "export?") #Nil])])) - (#Cons [(form$ (#Cons [(tag$ ["lux" "BoolA"]) - (#Cons [(bool$ true) - #Nil])])) - #Nil])]))) - #Nil) + (flag-meta "export?")) + (record$ #Nil)) (_lux_def hidden?-meta (_lux_: Code - (tuple$ (#Cons [(tuple$ (#Cons [(text$ "lux") (#Cons [(text$ "hidden?") #Nil])])) - (#Cons [(form$ (#Cons [(tag$ ["lux" "BoolA"]) - (#Cons [(bool$ true) - #Nil])])) - #Nil])]))) - #Nil) + (flag-meta "hidden?")) + (record$ #Nil)) (_lux_def macro?-meta (_lux_: Code - (tuple$ (#Cons [(tuple$ (#Cons [(text$ "lux") (#Cons [(text$ "macro?") #Nil])])) - (#Cons [(form$ (#Cons [(tag$ ["lux" "BoolA"]) - (#Cons [(bool$ true) - #Nil])])) - #Nil])]))) - #Nil) + (flag-meta "macro?")) + (record$ #Nil)) (_lux_def with-export-meta (_lux_: (#Function Code Code) @@ -857,7 +910,7 @@ (form$ (#Cons (tag$ ["lux" "Cons"]) (#Cons export?-meta (#Cons tail #Nil)))))) - #Nil) + (record$ #Nil)) (_lux_def with-hidden-meta (_lux_: (#Function Code Code) @@ -865,7 +918,7 @@ (form$ (#Cons (tag$ ["lux" "Cons"]) (#Cons hidden?-meta (#Cons tail #Nil)))))) - #Nil) + (record$ #Nil)) (_lux_def with-macro-meta (_lux_: (#Function Code Code) @@ -873,7 +926,7 @@ (form$ (#Cons (tag$ ["lux" "Cons"]) (#Cons macro?-meta (#Cons tail #Nil)))))) - #Nil) + (record$ #Nil)) (_lux_def def:'' (_lux_: Macro @@ -891,7 +944,10 @@ (#Cons [(_meta (#Tuple args)) (#Cons [body #Nil])])])]))) #Nil])])]))) - (#Cons (with-export-meta meta) #Nil)])])]))) + (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons (with-export-meta meta) + #Nil))) + #Nil)])])]))) #Nil])) (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) @@ -901,7 +957,10 @@ (#Cons [type (#Cons [body #Nil])])]))) - (#Cons (with-export-meta meta) #Nil)])])]))) + (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons (with-export-meta meta) + #Nil))) + #Nil)])])]))) #Nil])) (#Cons [[_ (#Form (#Cons [name args]))] @@ -915,7 +974,10 @@ (#Cons [(_meta (#Tuple args)) (#Cons [body #Nil])])])]))) #Nil])])]))) - (#Cons meta #Nil)])])]))) + (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons meta + #Nil))) + #Nil)])])]))) #Nil])) (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) @@ -925,13 +987,16 @@ (#Cons [type (#Cons [body #Nil])])]))) - (#Cons meta #Nil)])])]))) + (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons meta + #Nil))) + #Nil)])])]))) #Nil])) _ (fail "Wrong syntax for def''")) )) - default-macro-meta) + (record$ default-macro-meta)) (def:'' (macro:' tokens) default-macro-meta @@ -973,9 +1038,10 @@ (fail "Wrong syntax for macro:'"))) (macro:' #export (comment tokens) - (#Cons [["lux" "doc"] (#TextA "## Throws away any code given to it. - ## Great for commenting-out code, while retaining syntax high-lighting and formatting in your text editor. - (comment 1 2 3 4)")] + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Throws away any code given to it. + ## Great for commenting-out code, while retaining syntax high-lighting and formatting in your text editor. + (comment 1 2 3 4)")] #;Nil) (return #Nil)) @@ -995,7 +1061,7 @@ (fail "Wrong syntax for $'"))) (def:'' (map f xs) - #Nil + #;Nil (#UnivQ #Nil (#UnivQ #Nil (#Function (#Function (#Bound +3) (#Bound +1)) @@ -1009,12 +1075,12 @@ (#Cons (f x) (map f xs')))) (def:'' RepEnv - #Nil + #;Nil Type ($' List (#Product Text Code))) (def:'' (make-env xs ys) - #Nil + #;Nil (#Function ($' List Text) (#Function ($' List Code) RepEnv)) (_lux_case [xs ys] [(#Cons x xs') (#Cons y ys')] @@ -1023,20 +1089,20 @@ _ #Nil)) -(def:'' (Text/= x y) - #Nil +(def:'' (text/= x y) + #;Nil (#Function Text (#Function Text Bool)) (_lux_proc ["text" "="] [x y])) (def:'' (get-rep key env) - #Nil + #;Nil (#Function Text (#Function RepEnv ($' Maybe Code))) (_lux_case env #Nil #None (#Cons [k v] env') - (_lux_case (Text/= k key) + (_lux_case (text/= k key) true (#Some v) @@ -1044,7 +1110,7 @@ (get-rep key env')))) (def:'' (replace-syntax reps syntax) - #Nil + #;Nil (#Function RepEnv (#Function Code Code)) (_lux_case syntax [_ (#Symbol "" name)] @@ -1073,10 +1139,10 @@ syntax) ) -(def:'' (update-bounds ast) - #Nil +(def:'' (update-bounds code) + #;Nil (#Function Code Code) - (_lux_case ast + (_lux_case code [_ (#Tuple members)] (tuple$ (map update-bounds members)) @@ -1094,10 +1160,10 @@ (form$ (map update-bounds members)) _ - ast)) + code)) (def:'' (parse-quantified-args args next) - #Nil + #;Nil ## (-> (List Code) (-> (List Text) (Lux (List Code))) (Lux (List Code))) (#Function ($' List Code) (#Function (#Function ($' List Text) (#Apply ($' List Code) Lux)) @@ -1115,12 +1181,12 @@ )) (def:'' (make-bound idx) - #Nil + #;Nil (#Function Nat Code) (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ idx) #Nil)))) (def:'' (fold f init xs) - #Nil + #;Nil ## (All [a b] (-> (-> b a a) a (List b) a)) (#UnivQ #Nil (#UnivQ #Nil (#Function (#Function (#Bound +1) (#Function (#Bound +3) @@ -1136,20 +1202,21 @@ (fold f (f x init) xs'))) (def:'' (length list) - #Nil + #;Nil (#UnivQ #Nil (#Function ($' List (#Bound +1)) Int)) (fold (function'' [_ acc] (_lux_proc ["int" "+"] [1 acc])) 0 list)) (macro:' #export (All tokens) - (#Cons [["lux" "doc"] (#TextA "## Universal quantification. - (All [a] - (-> a a)) - - ## A name can be provided, to specify a recursive type. - (All List [a] - (| Unit - [a (List a)]))")] + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Universal quantification. + (All [a] + (-> a a)) + + ## A name can be provided, to specify a recursive type. + (All List [a] + (| Unit + [a (List a)]))")] #;Nil) (let'' [self-name tokens] (_lux_case tokens (#Cons [_ (#Symbol "" self-name)] tokens) @@ -1169,7 +1236,7 @@ (update-bounds body')) #Nil)))))) body names) - (return (#Cons (_lux_case [(Text/= "" self-name) names] + (return (#Cons (_lux_case [(text/= "" self-name) names] [true _] body' @@ -1191,16 +1258,17 @@ )) (macro:' #export (Ex tokens) - (#Cons [["lux" "doc"] (#TextA "## Existential quantification. - (Ex [a] - [(Codec Text a) - a]) - - ## A name can be provided, to specify a recursive type. - (Ex Self [a] - [(Codec Text a) - a - (List (Self a))])")] + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Existential quantification. + (Ex [a] + [(Codec Text a) + a]) + + ## A name can be provided, to specify a recursive type. + (Ex Self [a] + [(Codec Text a) + a + (List (Self a))])")] #;Nil) (let'' [self-name tokens] (_lux_case tokens (#Cons [_ (#Symbol "" self-name)] tokens) @@ -1220,7 +1288,7 @@ (update-bounds body')) #Nil)))))) body names) - (return (#Cons (_lux_case [(Text/= "" self-name) names] + (return (#Cons (_lux_case [(text/= "" self-name) names] [true _] body' @@ -1242,17 +1310,18 @@ )) (def:'' (reverse list) - #Nil + #;Nil (All [a] (#Function ($' List a) ($' List a))) (fold (function'' [head tail] (#Cons head tail)) #Nil list)) (macro:' #export (-> tokens) - (#Cons [["lux" "doc"] (#TextA "## Function types: - (-> Int Int Int) + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Function types: + (-> Int Int Int) - ## This is the type of a function that takes 2 Ints and returns an Int.")] + ## This is the type of a function that takes 2 Ints and returns an Int.")] #;Nil) (_lux_case (reverse tokens) (#Cons output inputs) @@ -1266,8 +1335,9 @@ (fail "Wrong syntax for ->"))) (macro:' #export (list xs) - (#Cons [["lux" "doc"] (#TextA "## List-construction macro. - (list 1 2 3)")] + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## List-construction macro. + (list 1 2 3)")] #;Nil) (return (#Cons (fold (function'' [head tail] (form$ (#Cons (tag$ ["lux" "Cons"]) @@ -1278,9 +1348,10 @@ #Nil))) (macro:' #export (list& xs) - (#Cons [["lux" "doc"] (#TextA "## List-construction macro, with the last element being a tail-list. - ## In other words, this macro prepends elements to another list. - (list& 1 2 3 (list 4 5 6))")] + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## List-construction macro, with the last element being a tail-list. + ## In other words, this macro prepends elements to another list. + (list& 1 2 3 (list 4 5 6))")] #;Nil) (_lux_case (reverse xs) (#Cons last init) @@ -1294,11 +1365,12 @@ (fail "Wrong syntax for list&"))) (macro:' #export (& tokens) - (#Cons [["lux" "doc"] (#TextA "## Tuple types: - (& Text Int Bool) + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Tuple types: + (& Text Int Bool) - ## The empty tuple, a.k.a. Unit. - (&)")] + ## The empty tuple, a.k.a. Unit. + (&)")] #;Nil) (_lux_case (reverse tokens) #Nil @@ -1311,11 +1383,12 @@ )) (macro:' #export (| tokens) - (#Cons [["lux" "doc"] (#TextA "## Variant types: - (| Text Int Bool) + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Variant types: + (| Text Int Bool) - ## The empty tuple, a.k.a. Void. - (|)")] + ## The empty tuple, a.k.a. Void. + (|)")] #;Nil) (_lux_case (reverse tokens) #Nil @@ -1368,7 +1441,9 @@ name (tuple$ args) body)))) - (with-export-meta meta))))) + (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons (with-export-meta meta) + #Nil))))))) (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) (return (list (form$ (list (symbol$ ["" "_lux_def"]) @@ -1376,7 +1451,9 @@ (form$ (list (symbol$ ["" "_lux_:"]) type body)) - (with-export-meta meta))))) + (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons (with-export-meta meta) + #Nil))))))) (#Cons [[_ (#Form (#Cons [name args]))] (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) @@ -1388,20 +1465,24 @@ name (tuple$ args) body)))) - meta)))) + (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons meta + #Nil))))))) (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) (return (list (form$ (list (symbol$ ["" "_lux_def"]) name (form$ (list (symbol$ ["" "_lux_:"]) type body)) - meta)))) + (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons meta + #Nil))))))) _ (fail "Wrong syntax for def'''") )) (def:''' (as-pairs xs) - #Nil + #;Nil (All [a] (-> ($' List a) ($' List (& a a)))) (_lux_case xs (#Cons x (#Cons y xs')) @@ -1426,7 +1507,7 @@ (fail "Wrong syntax for let'"))) (def:''' (any? p xs) - #Nil + #;Nil (All [a] (-> (-> a Bool) ($' List a) Bool)) (_lux_case xs @@ -1439,7 +1520,7 @@ false (any? p xs')))) (def:''' (spliced? token) - #Nil + #;Nil (-> Code Bool) (_lux_case token [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [_ #Nil])]))] @@ -1449,13 +1530,13 @@ false)) (def:''' (wrap-meta content) - #Nil + #;Nil (-> Code Code) (tuple$ (list (tuple$ (list (text$ "") (nat$ +0) (nat$ +0))) content))) (def:''' (untemplate-list tokens) - #Nil + #;Nil (-> ($' List Code) Code) (_lux_case tokens #Nil @@ -1464,18 +1545,19 @@ (#Cons [token tokens']) (_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) token (untemplate-list tokens')))))) -(def:''' (List/compose xs ys) - #Nil +(def:''' (list/compose xs ys) + #;Nil (All [a] (-> ($' List a) ($' List a) ($' List a))) (_lux_case xs (#Cons x xs') - (#Cons x (List/compose xs' ys)) + (#Cons x (list/compose xs' ys)) #Nil ys)) (def:''' #export (splice-helper xs ys) - (#Cons [["lux" "hidden?"] (#BoolA true)] + (#Cons [(tag$ ["lux" "hidden?"]) + (bool$ true)] #;Nil) (-> ($' List Code) ($' List Code) ($' List Code)) (_lux_case xs @@ -1490,17 +1572,18 @@ (-> Code Code Code Code) (_lux_case op [_ (#Form parts)] - (form$ (List/compose parts (list a1 a2))) + (form$ (list/compose parts (list a1 a2))) _ (form$ (list op a1 a2)))) (macro:' #export (_$ tokens) - (#Cons [["lux" "doc"] (#TextA "## Left-association for the application of binary functions over variadic arguments. - (_$ Text/compose \"Hello, \" name \".\\nHow are you?\") + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Left-association for the application of binary functions over variadic arguments. + (_$ text/compose \"Hello, \" name \".\\nHow are you?\") - ## => - (Text/compose (Text/compose \"Hello, \" name) \".\\nHow are you?\")")] + ## => + (text/compose (text/compose \"Hello, \" name) \".\\nHow are you?\")")] #;Nil) (_lux_case tokens (#Cons op tokens') @@ -1515,11 +1598,12 @@ (fail "Wrong syntax for _$"))) (macro:' #export ($_ tokens) - (#Cons [["lux" "doc"] (#TextA "## Right-association for the application of binary functions over variadic arguments. - ($_ Text/compose \"Hello, \" name \".\\nHow are you?\") + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Right-association for the application of binary functions over variadic arguments. + ($_ text/compose \"Hello, \" name \".\\nHow are you?\") - ## => - (Text/compose \"Hello, \" (Text/compose name \".\\nHow are you?\"))")] + ## => + (text/compose \"Hello, \" (text/compose name \".\\nHow are you?\"))")] #;Nil) (_lux_case tokens (#Cons op tokens') @@ -1539,7 +1623,8 @@ ## (: (All [a b] (-> (-> a (m b)) (m a) (m b))) ## bind)) (def:''' Monad - (list& [["lux" "tags"] (#ListA (list (#TextA "wrap") (#TextA "bind")))] + (list& [(tag$ ["lux" "tags"]) + (tuple$ (list (text$ "wrap") (text$ "bind")))] default-def-meta-unexported) Type (#Named ["lux" "Monad"] @@ -1627,13 +1712,14 @@ ))) (macro:' #export (if tokens) - (list [["lux" "doc"] (#TextA "Picks which expression to evaluate based on a boolean test value. + (list [(tag$ ["lux" "doc"]) + (text$ "Picks which expression to evaluate based on a boolean test value. - (if true - \"Oh, yeah!\" - \"Aw hell naw!\") + (if true + \"Oh, yeah!\" + \"Aw hell naw!\") - == \"Oh, yeah!\"")]) + => \"Oh, yeah!\"")]) (_lux_case tokens (#Cons test (#Cons then (#Cons else #Nil))) (return (list (form$ (list (symbol$ ["" "_lux_case"]) test @@ -1649,7 +1735,7 @@ (-> Text ($' List (& Text a)) ($' Maybe a))) (_lux_case plist (#Cons [[k' v] plist']) - (if (Text/= k k') + (if (text/= k k') (#Some v) (get k plist')) @@ -1665,45 +1751,56 @@ (list [k v]) (#Cons [[k' v'] dict']) - (if (Text/= k k') + (if (text/= k k') (#Cons [[k' v] dict']) (#Cons [[k' v'] (put k v dict')])))) (def:''' #export (log! message) - (list [["lux" "doc"] (#TextA "Logs message to standard output. + (list [(tag$ ["lux" "doc"]) + (text$ "Logs message to standard output. - Useful for debugging.")]) + Useful for debugging.")]) (-> Text Unit) (_lux_proc ["io" "log"] [message])) -(def:''' (Text/compose x y) +(def:''' (text/compose x y) #Nil (-> Text Text Text) (_lux_proc ["text" "append"] [x y])) -(def:''' (Ident/encode ident) +(def:''' (ident/encode ident) #Nil (-> Ident Text) (let' [[module name] ident] (_lux_case module "" name - _ ($_ Text/compose module ";" name)))) + _ ($_ text/compose module ";" name)))) (def:''' (get-meta tag def-meta) #Nil - (-> Ident Anns ($' Maybe Ann-Value)) + (-> Ident Code ($' Maybe Code)) (let' [[prefix name] tag] (_lux_case def-meta - (#Cons [[prefix' name'] value] def-meta') - (_lux_case [(Text/= prefix prefix') - (Text/= name name')] - [true true] - (#Some value) + [_ (#Record def-meta)] + (_lux_case def-meta + (#Cons [key value] def-meta') + (_lux_case key + [_ (#Tag [prefix' name'])] + (_lux_case [(text/= prefix prefix') + (text/= name name')] + [true true] + (#Some value) - _ - (get-meta tag def-meta')) + _ + (get-meta tag (record$ def-meta'))) - #Nil + _ + (get-meta tag (record$ def-meta'))) + + #Nil + #None) + + _ #None))) (def:''' (resolve-global-symbol ident state) @@ -1715,21 +1812,21 @@ #seed seed #expected expected #cursor cursor #scope-type-vars scope-type-vars} state] (_lux_case (get module modules) - (#Some {#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _ #module-state _}) + (#Some {#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-annotations _ #module-state _}) (_lux_case (get name defs) (#Some [def-type def-meta def-value]) (_lux_case (get-meta ["lux" "alias"] def-meta) - (#Some (#IdentA real-name)) + (#Some [_ (#Symbol real-name)]) (#Right [state real-name]) _ (#Right [state ident])) #None - (#Left ($_ Text/compose "Unknown definition: " (Ident/encode ident)))) + (#Left ($_ text/compose "Unknown definition: " (ident/encode ident)))) #None - (#Left ($_ Text/compose "Unknown module: " module " @ " (Ident/encode ident)))))) + (#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident)))))) (def:''' (splice replace? untemplate tag elems) #Nil @@ -1806,7 +1903,7 @@ (do Monad<Lux> [real-name (_lux_case module "" - (if (Text/= "" subst) + (if (text/= "" subst) (wrap [module name]) (resolve-global-symbol [subst name])) @@ -1848,10 +1945,11 @@ )) (macro:' #export (host tokens) - (list [["lux" "doc"] (#TextA "## Macro to treat host-types as Lux-types. - (host java.lang.Object) + (list [(tag$ ["lux" "doc"]) + (text$ "## Macro to treat host-types as Lux-types. + (host java.lang.Object) - (host java.util.List [java.lang.Long])")]) + (host java.util.List [java.lang.Long])")]) (_lux_case tokens (#Cons [_ (#Symbol "" class-name)] #Nil) (return (list (form$ (list (tag$ ["lux" "Host"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) @@ -1879,11 +1977,12 @@ ))) (macro:' #export (` tokens) - (list [["lux" "doc"] (#TextA "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. - ## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used. - (` (def: (~ name) - (function [(~@ args)] - (~ body))))")]) + (list [(tag$ ["lux" "doc"]) + (text$ "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. + ## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used. + (` (def: (~ name) + (function [(~@ args)] + (~ body))))")]) (_lux_case tokens (#Cons template #Nil) (do Monad<Lux> @@ -1895,10 +1994,11 @@ (fail "Wrong syntax for `"))) (macro:' #export (`' tokens) - (list [["lux" "doc"] (#TextA "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. - (`' (def: (~ name) - (function [(~@ args)] - (~ body))))")]) + (list [(tag$ ["lux" "doc"]) + (text$ "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. + (`' (def: (~ name) + (function [(~@ args)] + (~ body))))")]) (_lux_case tokens (#Cons template #Nil) (do Monad<Lux> @@ -1909,8 +2009,9 @@ (fail "Wrong syntax for `"))) (macro:' #export (' tokens) - (list [["lux" "doc"] (#TextA "## Quotation as a macro. - (' \"YOLO\")")]) + (list [(tag$ ["lux" "doc"]) + (text$ "## Quotation as a macro. + (' \"YOLO\")")]) (_lux_case tokens (#Cons template #Nil) (do Monad<Lux> @@ -1921,23 +2022,24 @@ (fail "Wrong syntax for '"))) (macro:' #export (|> tokens) - (list [["lux" "doc"] (#TextA "## Piping macro. - (|> elems (map Int/encode) (interpose \" \") (fold Text/compose \"\")) - - ## => - (fold Text/compose \"\" - (interpose \" \" - (map Int/encode elems)))")]) + (list [(tag$ ["lux" "doc"]) + (text$ "## Piping macro. + (|> elems (map int/encode) (interpose \" \") (fold text/compose \"\")) + + ## => + (fold text/compose \"\" + (interpose \" \" + (map int/encode elems)))")]) (_lux_case tokens (#Cons [init apps]) (return (list (fold (_lux_: (-> Code Code Code) (function' [app acc] (_lux_case app [_ (#Tuple parts)] - (tuple$ (List/compose parts (list acc))) + (tuple$ (list/compose parts (list acc))) [_ (#Form parts)] - (form$ (List/compose parts (list acc))) + (form$ (list/compose parts (list acc))) _ (` ((~ app) (~ acc)))))) @@ -1948,23 +2050,24 @@ (fail "Wrong syntax for |>"))) (macro:' #export (<| tokens) - (list [["lux" "doc"] (#TextA "## Reverse piping macro. - (<| (fold Text/compose \"\") (interpose \" \") (map Int/encode) elems) - - ## => - (fold Text/compose \"\" - (interpose \" \" - (map Int/encode elems)))")]) + (list [(tag$ ["lux" "doc"]) + (text$ "## Reverse piping macro. + (<| (fold text/compose \"\") (interpose \" \") (map int/encode) elems) + + ## => + (fold text/compose \"\" + (interpose \" \" + (map int/encode elems)))")]) (_lux_case (reverse tokens) (#Cons [init apps]) (return (list (fold (_lux_: (-> Code Code Code) (function' [app acc] (_lux_case app [_ (#Tuple parts)] - (tuple$ (List/compose parts (list acc))) + (tuple$ (list/compose parts (list acc))) [_ (#Form parts)] - (form$ (List/compose parts (list acc))) + (form$ (list/compose parts (list acc))) _ (` ((~ app) (~ acc)))))) @@ -1975,7 +2078,8 @@ (fail "Wrong syntax for <|"))) (def:''' #export (. f g) - (list [["lux" "doc"] (#TextA "Function composition.")]) + (list [(tag$ ["lux" "doc"]) + (text$ "Function composition.")]) (All [a b c] (-> (-> b c) (-> a b) (-> a c))) (function' [x] (f (g x)))) @@ -2057,7 +2161,7 @@ #Nil (#Cons [x xs']) - (List/compose (f x) (join-map f xs')))) + (list/compose (f x) (join-map f xs')))) (def:''' (every? p xs) #Nil @@ -2066,14 +2170,15 @@ (fold (function' [_2 _1] (if _1 (p _2) false)) true xs)) (macro:' #export (do-template tokens) - (list [["lux" "doc"] (#TextA "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary. - (do-template [<name> <diff>] - [(def: #export <name> - (-> Int Int) - (i.+ <diff>))] - - [i.inc 1] - [i.dec -1])")]) + (list [(tag$ ["lux" "doc"]) + (text$ "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary. + (do-template [<name> <diff>] + [(def: #export <name> + (-> Int Int) + (i.+ <diff>))] + + [i.inc 1] + [i.dec -1])")]) (_lux_case tokens (#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) (_lux_case [(mapM Monad<Maybe> get-name bindings) @@ -2098,29 +2203,29 @@ (do-template [<type> <category> <=-name> <lt-name> <lte-name> <gt-name> <gte-name> <eq-doc> <<-doc> <<=-doc> <>-doc> <>=-doc>] [(def:''' #export (<=-name> test subject) - (list [["lux" "doc"] (#TextA <eq-doc>)]) + (list [(tag$ ["lux" "doc"]) (text$ <eq-doc>)]) (-> <type> <type> Bool) (_lux_proc [<category> "="] [subject test])) (def:''' #export (<lt-name> test subject) - (list [["lux" "doc"] (#TextA <<-doc>)]) + (list [(tag$ ["lux" "doc"]) (text$ <<-doc>)]) (-> <type> <type> Bool) (_lux_proc [<category> "<"] [subject test])) (def:''' #export (<lte-name> test subject) - (list [["lux" "doc"] (#TextA <<=-doc>)]) + (list [(tag$ ["lux" "doc"]) (text$ <<=-doc>)]) (-> <type> <type> Bool) (if (_lux_proc [<category> "<"] [subject test]) true (_lux_proc [<category> "="] [subject test]))) (def:''' #export (<gt-name> test subject) - (list [["lux" "doc"] (#TextA <>-doc>)]) + (list [(tag$ ["lux" "doc"]) (text$ <>-doc>)]) (-> <type> <type> Bool) (_lux_proc [<category> "<"] [test subject])) (def:''' #export (<gte-name> test subject) - (list [["lux" "doc"] (#TextA <>=-doc>)]) + (list [(tag$ ["lux" "doc"]) (text$ <>=-doc>)]) (-> <type> <type> Bool) (if (_lux_proc [<category> "<"] [test subject]) true @@ -2141,7 +2246,7 @@ (do-template [<type> <name> <op> <doc>] [(def:''' #export (<name> param subject) - (list [["lux" "doc"] (#TextA <doc>)]) + (list [(tag$ ["lux" "doc"]) (text$ <doc>)]) (-> <type> <type> <type>) (_lux_proc <op> [subject param]))] @@ -2172,7 +2277,7 @@ (do-template [<type> <name> <op> <doc>] [(def:''' #export (<name> param subject) - (list [["lux" "doc"] (#TextA <doc>)]) + (list [(tag$ ["lux" "doc"]) (text$ <doc>)]) (-> Nat <type> <type>) (_lux_proc <op> [subject param]))] @@ -2182,7 +2287,7 @@ (do-template [<name> <type> <test> <doc>] [(def:''' #export (<name> left right) - (list [["lux" "doc"] (#TextA <doc>)]) + (list [(tag$ ["lux" "doc"]) (text$ <doc>)]) (-> <type> <type> <type>) (if (<test> right left) left @@ -2201,7 +2306,7 @@ [f.max Frac f.> "Frac minimum."] ) -(def:''' (Bool/encode x) +(def:''' (bool/encode x) #Nil (-> Bool Text) (if x "true" "false")) @@ -2216,7 +2321,7 @@ +7 "7" +8 "8" +9 "9" _ (_lux_proc ["io" "error"] ["undefined"]))) -(def:''' (Nat/encode value) +(def:''' (nat/encode value) #Nil (-> Nat Text) (_lux_case value @@ -2233,14 +2338,14 @@ output])))))] (loop value "")))) -(def:''' (Int/abs value) +(def:''' (int/abs value) #Nil (-> Int Int) (if (i.< 0 value) (i.* -1 value) value)) -(def:''' (Int/encode value) +(def:''' (int/encode value) #Nil (-> Int Text) (if (i.= 0 value) @@ -2255,10 +2360,10 @@ (recur (i./ 10 input) (_lux_proc ["text" "append"] [(|> input (i.% 10) (_lux_:! Nat) digit-to-text) output]))))) - (|> value (i./ 10) Int/abs) - (|> value (i.% 10) Int/abs (_lux_:! Nat) digit-to-text))))) + (|> value (i./ 10) int/abs) + (|> value (i.% 10) int/abs (_lux_:! Nat) digit-to-text))))) -(def:''' (Frac/encode x) +(def:''' (frac/encode x) #Nil (-> Frac Text) (_lux_proc ["frac" "encode"] [x])) @@ -2269,11 +2374,12 @@ (i.= 0 (i.% div n))) (def:''' #export (not x) - (list [["lux" "doc"] (#TextA "## Boolean negation. + (list [(tag$ ["lux" "doc"]) + (text$ "## Boolean negation. - (not true) == false + (not true) => false - (not false) == true")]) + (not false) => true")]) (-> Bool Bool) (if x false true)) @@ -2284,23 +2390,23 @@ ($' Maybe Macro)) (do Monad<Maybe> [$module (get module modules) - gdef (let' [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _ #module-state _} (_lux_: Module $module)] + gdef (let' [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} (_lux_: Module $module)] (get name bindings))] (let' [[def-type def-meta def-value] (_lux_: Def gdef)] (_lux_case (get-meta ["lux" "macro?"] def-meta) - (#Some (#BoolA true)) + (#Some [_ (#Bool true)]) (_lux_case (get-meta ["lux" "export?"] def-meta) - (#Some (#BoolA true)) + (#Some [_ (#Bool true)]) (#Some (_lux_:! Macro def-value)) _ - (if (Text/= module current-module) + (if (text/= module current-module) (#Some (_lux_:! Macro def-value)) #None)) _ (_lux_case (get-meta ["lux" "alias"] def-meta) - (#Some (#IdentA [r-module r-name])) + (#Some [_ (#Symbol [r-module r-name])]) (find-macro' modules current-module r-module r-name) _ @@ -2345,11 +2451,11 @@ (#Some _) true #None false)))) -(def:''' (List/join xs) +(def:''' (list/join xs) #Nil (All [a] (-> ($' List ($' List a)) ($' List a))) - (fold List/compose #Nil (reverse xs))) + (fold list/compose #Nil (reverse xs))) (def:''' (interpose sep xs) #Nil @@ -2396,7 +2502,7 @@ (do Monad<Lux> [expansion (macro args) expansion' (mapM Monad<Lux> macro-expand expansion)] - (wrap (List/join expansion'))) + (wrap (list/join expansion'))) #None (return (list token)))) @@ -2417,22 +2523,22 @@ (do Monad<Lux> [expansion (macro args) expansion' (mapM Monad<Lux> macro-expand-all expansion)] - (wrap (List/join expansion'))) + (wrap (list/join expansion'))) #None (do Monad<Lux> [args' (mapM Monad<Lux> macro-expand-all args)] - (wrap (list (form$ (#Cons (symbol$ macro-name) (List/join args')))))))) + (wrap (list (form$ (#Cons (symbol$ macro-name) (list/join args')))))))) [_ (#Form members)] (do Monad<Lux> [members' (mapM Monad<Lux> macro-expand-all members)] - (wrap (list (form$ (List/join members'))))) + (wrap (list (form$ (list/join members'))))) [_ (#Tuple members)] (do Monad<Lux> [members' (mapM Monad<Lux> macro-expand-all members)] - (wrap (list (tuple$ (List/join members'))))) + (wrap (list (tuple$ (list/join members'))))) [_ (#Record pairs)] (do Monad<Lux> @@ -2473,8 +2579,9 @@ type)) (macro:' #export (type tokens) - (list [["lux" "doc"] (#TextA "## Takes a type expression and returns it's representation as data-structure. - (type (All [a] (Maybe (List a))))")]) + (list [(tag$ ["lux" "doc"]) + (text$ "## Takes a type expression and returns it's representation as data-structure. + (type (All [a] (Maybe (List a))))")]) (_lux_case tokens (#Cons type #Nil) (do Monad<Lux> @@ -2490,8 +2597,9 @@ (fail "Wrong syntax for type"))) (macro:' #export (: tokens) - (list [["lux" "doc"] (#TextA "## The type-annotation macro. - (: (List Int) (list 1 2 3))")]) + (list [(tag$ ["lux" "doc"]) + (text$ "## The type-annotation macro. + (: (List Int) (list 1 2 3))")]) (_lux_case tokens (#Cons type (#Cons value #Nil)) (return (list (` (;_lux_: (type (~ type)) (~ value))))) @@ -2500,8 +2608,9 @@ (fail "Wrong syntax for :"))) (macro:' #export (:! tokens) - (list [["lux" "doc"] (#TextA "## The type-coercion macro. - (:! Dinosaur (list 1 2 3))")]) + (list [(tag$ ["lux" "doc"]) + (text$ "## The type-coercion macro. + (:! Dinosaur (list 1 2 3))")]) (_lux_case tokens (#Cons type (#Cons value #Nil)) (return (list (` (;_lux_:! (type (~ type)) (~ value))))) @@ -2525,10 +2634,10 @@ [first a x] [second b y]) -(def:''' (unfold-type-def type-asts) +(def:''' (unfold-type-def type-codes) #Nil (-> ($' List Code) ($' Lux (& Code ($' Maybe ($' List Text))))) - (_lux_case type-asts + (_lux_case type-codes (#Cons [_ (#Record pairs)] #;Nil) (do Monad<Lux> [members (mapM Monad<Lux> @@ -2593,13 +2702,14 @@ #seed (n.+ +1 seed) #expected expected #cursor cursor #scope-type-vars scope-type-vars} - (symbol$ ["" ($_ Text/compose "__gensym__" prefix (Nat/encode seed))])))) + (symbol$ ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))])))) (macro:' #export (Rec tokens) - (list [["lux" "doc"] (#TextA "## Parameter-less recursive types. - ## A name has to be given to the whole type, to use it within its body. - (Rec Self - [Int (List Self)])")]) + (list [(tag$ ["lux" "doc"]) + (text$ "## Parameter-less recursive types. + ## A name has to be given to the whole type, to use it within its body. + (Rec Self + [Int (List Self)])")]) (_lux_case tokens (#Cons [_ (#Symbol "" name)] (#Cons body #Nil)) (let' [body' (replace-syntax (list [name (` (#Apply (~ (make-bound +1)) (~ (make-bound +0))))]) @@ -2610,12 +2720,13 @@ (fail "Wrong syntax for Rec"))) (macro:' #export (exec tokens) - (list [["lux" "doc"] (#TextA "## Sequential execution of expressions (great for side-effects). - (exec - (log! \"#1\") - (log! \"#2\") - (log! \"#3\") - \"YOLO\")")]) + (list [(tag$ ["lux" "doc"]) + (text$ "## Sequential execution of expressions (great for side-effects). + (exec + (log! \"#1\") + (log! \"#2\") + (log! \"#3\") + \"YOLO\")")]) (_lux_case (reverse tokens) (#Cons value actions) (let' [dummy (symbol$ ["" ""])] @@ -2629,7 +2740,7 @@ (macro:' (def:' tokens) (let' [[export? tokens'] (_lux_case tokens - (#Cons [_ (#Tag "" "export")] tokens') + (#Cons [_ (#Tag ["" "export"])] tokens') [true tokens'] _ @@ -2665,9 +2776,10 @@ #None body')] (return (list (` (;_lux_def (~ name) (~ body'') - (~ (if export? - (with-export-meta (tag$ ["lux" "Nil"])) - (tag$ ["lux" "Nil"])))))))) + [(~ cursor-code) + (#;Record (~ (if export? + (with-export-meta (tag$ ["lux" "Nil"])) + (tag$ ["lux" "Nil"]))))]))))) #None (fail "Wrong syntax for def'")))) @@ -2677,57 +2789,57 @@ (let' [[left right] pair] (list left right))) -(def:' (ast-to-text ast) +(def:' (code-to-text code) (-> Code Text) - (_lux_case ast + (_lux_case code [_ (#Bool value)] - (Bool/encode value) + (bool/encode value) [_ (#Nat value)] - (Nat/encode value) + (nat/encode value) [_ (#Int value)] - (Int/encode value) + (int/encode value) [_ (#Deg value)] (_lux_proc ["io" "error"] ["Undefined behavior."]) [_ (#Frac value)] - (Frac/encode value) + (frac/encode value) [_ (#Text value)] - ($_ Text/compose "\"" value "\"") + ($_ text/compose "\"" value "\"") [_ (#Symbol [prefix name])] - (if (Text/= "" prefix) + (if (text/= "" prefix) name - ($_ Text/compose prefix ";" name)) + ($_ text/compose prefix ";" name)) [_ (#Tag [prefix name])] - (if (Text/= "" prefix) - ($_ Text/compose "#" name) - ($_ Text/compose "#" prefix ";" name)) + (if (text/= "" prefix) + ($_ text/compose "#" name) + ($_ text/compose "#" prefix ";" name)) [_ (#Form xs)] - ($_ Text/compose "(" (|> xs - (map ast-to-text) + ($_ text/compose "(" (|> xs + (map code-to-text) (interpose " ") reverse - (fold Text/compose "")) ")") + (fold text/compose "")) ")") [_ (#Tuple xs)] - ($_ Text/compose "[" (|> xs - (map ast-to-text) + ($_ text/compose "[" (|> xs + (map code-to-text) (interpose " ") reverse - (fold Text/compose "")) "]") + (fold text/compose "")) "]") [_ (#Record kvs)] - ($_ Text/compose "{" (|> kvs - (map (function' [kv] (_lux_case kv [k v] ($_ Text/compose (ast-to-text k) " " (ast-to-text v))))) + ($_ text/compose "{" (|> kvs + (map (function' [kv] (_lux_case kv [k v] ($_ text/compose (code-to-text k) " " (code-to-text v))))) (interpose " ") reverse - (fold Text/compose "")) "}") + (fold text/compose "")) "}") )) (def:' (expander branches) @@ -2757,21 +2869,22 @@ (do Monad<Lux> [] (wrap (list))) _ - (fail ($_ Text/compose "\"lux;case\" expects an even number of tokens: " (|> branches - (map ast-to-text) + (fail ($_ text/compose "\"lux;case\" expects an even number of tokens: " (|> branches + (map code-to-text) (interpose " ") reverse - (fold Text/compose "")))))) + (fold text/compose "")))))) (macro:' #export (case tokens) - (list [["lux" "doc"] (#TextA "## The pattern-matching macro. - ## Allows the usage of macros within the patterns to provide custom syntax. - (case (: (List Int) (list 1 2 3)) - (#Cons x (#Cons y (#Cons z #Nil))) - (#Some ($_ i.* x y z)) + (list [(tag$ ["lux" "doc"]) + (text$ "## The pattern-matching macro. + ## Allows the usage of macros within the patterns to provide custom syntax. + (case (: (List Int) (list 1 2 3)) + (#Cons x (#Cons y (#Cons z #Nil))) + (#Some ($_ i.* x y z)) - _ - #None)")]) + _ + #None)")]) (_lux_case tokens (#Cons value branches) (do Monad<Lux> @@ -2782,14 +2895,15 @@ (fail "Wrong syntax for case"))) (macro:' #export (^ tokens) - (list [["lux" "doc"] (#TextA "## Macro-expanding patterns. - ## It's a special macro meant to be used with 'case'. - (case (: (List Int) (list 1 2 3)) - (^ (list x y z)) - (#Some ($_ i.* x y z)) + (list [(tag$ ["lux" "doc"]) + (text$ "## Macro-expanding patterns. + ## It's a special macro meant to be used with 'case'. + (case (: (List Int) (list 1 2 3)) + (^ (list x y z)) + (#Some ($_ i.* x y z)) - _ - #None)")]) + _ + #None)")]) (case tokens (#Cons [_ (#Form (#Cons pattern #Nil))] (#Cons body branches)) (do Monad<Lux> @@ -2805,25 +2919,26 @@ (fail "Wrong syntax for ^ macro"))) (macro:' #export (^or tokens) - (list [["lux" "doc"] (#TextA "## Or-patterns. - ## It's a special macro meant to be used with 'case'. - (type: Weekday - #Monday - #Tuesday - #Wednesday - #Thursday - #Friday - #Saturday - #Sunday) - - (def: (weekend? day) - (-> Weekday Bool) - (case day - (^or #Saturday #Sunday) - true - - _ - false))")]) + (list [(tag$ ["lux" "doc"]) + (text$ "## Or-patterns. + ## It's a special macro meant to be used with 'case'. + (type: Weekday + #Monday + #Tuesday + #Wednesday + #Thursday + #Friday + #Saturday + #Sunday) + + (def: (weekend? day) + (-> Weekday Bool) + (case day + (^or #Saturday #Sunday) + true + + _ + false))")]) (case tokens (^ (list& [_ (#Form patterns)] body branches)) (case patterns @@ -2833,14 +2948,14 @@ _ (let' [pairs (|> patterns (map (function' [pattern] (list pattern body))) - (List/join))] - (return (List/compose pairs branches)))) + (list/join))] + (return (list/compose pairs branches)))) _ (fail "Wrong syntax for ^or"))) -(def:' (symbol? ast) +(def:' (symbol? code) (-> Code Bool) - (case ast + (case code [_ (#Symbol _)] true @@ -2848,11 +2963,12 @@ false)) (macro:' #export (let tokens) - (list [["lux" "doc"] (#TextA "## Creates local bindings. - ## Can (optionally) use pattern-matching macros when binding. - (let [x (foo bar) - y (baz quux)] - (op x y))")]) + (list [(tag$ ["lux" "doc"]) + (text$ "## Creates local bindings. + ## Can (optionally) use pattern-matching macros when binding. + (let [x (foo bar) + y (baz quux)] + (op x y))")]) (case tokens (^ (list [_ (#Tuple bindings)] body)) (if (multiple? 2 (length bindings)) @@ -2872,13 +2988,14 @@ (fail "Wrong syntax for let"))) (macro:' #export (function tokens) - (list [["lux" "doc"] (#TextA "## Syntax for creating functions. - ## Allows for giving the function itself a name, for the sake of recursion. - (: (All [a b] (-> a b a)) - (function [x y] x)) - - (: (All [a b] (-> a b a)) - (function const [x y] x))")]) + (list [(tag$ ["lux" "doc"]) + (text$ "## Syntax for creating functions. + ## Allows for giving the function itself a name, for the sake of recursion. + (: (All [a b] (-> a b a)) + (function [x y] x)) + + (: (All [a b] (-> a b a)) + (function const [x y] x))")]) (case (: (Maybe [Ident Code (List Code) Code]) (case tokens (^ (list [_ (#Tuple (#Cons head tail))] body)) @@ -2907,77 +3024,56 @@ #None (fail "Wrong syntax for function"))) -(def:' (process-def-meta-value ast) - (-> Code (Lux Code)) - (case ast +(def:' (process-def-meta-value code) + (-> Code Code) + (case code [_ (#Bool value)] - (return (form$ (list (tag$ ["lux" "BoolA"]) (bool$ value)))) + (meta-code ["lux" "Bool"] (bool$ value)) [_ (#Nat value)] - (return (form$ (list (tag$ ["lux" "NatA"]) (nat$ value)))) + (meta-code ["lux" "Nat"] (nat$ value)) [_ (#Int value)] - (return (form$ (list (tag$ ["lux" "IntA"]) (int$ value)))) + (meta-code ["lux" "Int"] (int$ value)) [_ (#Deg value)] - (return (form$ (list (tag$ ["lux" "DegA"]) (deg$ value)))) + (meta-code ["lux" "Deg"] (deg$ value)) [_ (#Frac value)] - (return (form$ (list (tag$ ["lux" "FracA"]) (frac$ value)))) + (meta-code ["lux" "Frac"] (frac$ value)) [_ (#Text value)] - (return (form$ (list (tag$ ["lux" "TextA"]) (text$ value)))) + (meta-code ["lux" "Text"] (text$ value)) [_ (#Tag [prefix name])] - (return (form$ (list (tag$ ["lux" "IdentA"]) (tuple$ (list (text$ prefix) (text$ name)))))) + (meta-code ["lux" "Tag"] (` [(~ (text$ prefix)) (~ (text$ name))])) (^or [_ (#Form _)] [_ (#Symbol _)]) - (return ast) + code [_ (#Tuple xs)] - (do Monad<Lux> - [=xs (mapM Monad<Lux> process-def-meta-value xs)] - (wrap (form$ (list (tag$ ["lux" "ListA"]) (untemplate-list =xs))))) + (|> xs + (map process-def-meta-value) + untemplate-list + (meta-code ["lux" "Tuple"])) [_ (#Record kvs)] - (do Monad<Lux> - [=xs (mapM Monad<Lux> - (: (-> [Code Code] (Lux Code)) - (function [[k v]] - (case k - [_ (#Text =k)] - (do Monad<Lux> - [=v (process-def-meta-value v)] - (wrap (tuple$ (list (text$ =k) =v)))) - - _ - (fail (Text/compose "Wrong syntax for DictA key: " (ast-to-text k)))))) - kvs)] - (wrap (form$ (list (tag$ ["lux" "DictA"]) (untemplate-list =xs))))) + (|> kvs + (map (: (-> [Code Code] Code) + (function [[k v]] + (` [(~ (process-def-meta-value k)) + (~ (process-def-meta-value v))])))) + untemplate-list + (meta-code ["lux" "Record"])) )) -(def:' (process-def-meta ast) - (-> Code (Lux Code)) - (case ast - [_ (#Record kvs)] - (do Monad<Lux> - [=kvs (mapM Monad<Lux> - (: (-> [Code Code] (Lux Code)) - (function [[k v]] - (case k - [_ (#Tag [pk nk])] - (do Monad<Lux> - [=v (process-def-meta-value v)] - (wrap (tuple$ (list (tuple$ (list (text$ pk) (text$ nk))) - =v)))) - - _ - (fail (Text/compose "Wrong syntax for Anns: " (ast-to-text ast)))))) - kvs)] - (wrap (untemplate-list =kvs))) - - _ - (fail (Text/compose "Wrong syntax for Anns: " (ast-to-text ast))))) +(def:' (process-def-meta kvs) + (-> (List [Code Code]) Code) + (untemplate-list (map (: (-> [Code Code] Code) + (function [[k v]] + (` [(~ (process-def-meta-value k)) + (~ (process-def-meta-value v))]))) + kvs))) (def:' (with-func-args args meta) (-> (List Code) Code Code) @@ -2986,17 +3082,16 @@ meta _ - (` (#;Cons [["lux" "func-args"] - (#;ListA (list (~@ (map (function [arg] - (` (#;TextA (~ (text$ (ast-to-text arg)))))) - args))))] + (` (#;Cons [[(~ cursor-code) (#;Tag ["lux" "func-args"])] + [(~ cursor-code) (#;Tuple (;list (~@ (map (function [arg] + (` [(~ cursor-code) (#;Text (~ (text$ (code-to-text arg))))])) + args))))]] (~ meta))))) (def:' (with-type-args args) (-> (List Code) Code) - (` {#;type-args (#;ListA (list (~@ (map (function [arg] - (` (#;TextA (~ (text$ (ast-to-text arg)))))) - args))))})) + (` {#;type-args [(~@ (map (function [arg] (text$ (code-to-text arg))) + args))]})) (def:' Export-Level Type @@ -3030,41 +3125,42 @@ (list (' #hidden)))) (macro:' #export (def: tokens) - (list [["lux" "doc"] (#TextA "## Defines global constants/functions. - (def: (rejoin-pair pair) - (-> [Code Code] (List Code)) - (let [[left right] pair] - (list left right))) - - (def: branching-exponent - Int - 5)")]) + (list [(tag$ ["lux" "doc"]) + (text$ "## Defines global constants/functions. + (def: (rejoin-pair pair) + (-> [Code Code] (List Code)) + (let [[left right] pair] + (list left right))) + + (def: branching-exponent + Int + 5)")]) (let [[export? tokens'] (export-level^ tokens) - parts (: (Maybe [Code (List Code) (Maybe Code) Code Code]) + parts (: (Maybe [Code (List Code) (Maybe Code) Code (List [Code Code])]) (case tokens' - (^ (list [_ (#Form (#Cons name args))] meta type body)) - (#Some [name args (#Some type) body meta]) + (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] type body)) + (#Some [name args (#Some type) body meta-kvs]) - (^ (list name meta type body)) - (#Some [name #Nil (#Some type) body meta]) + (^ (list name [_ (#Record meta-kvs)] type body)) + (#Some [name #Nil (#Some type) body meta-kvs]) (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] body)) - (#Some [name args #None body (record$ meta-kvs)]) + (#Some [name args #None body meta-kvs]) (^ (list name [_ (#Record meta-kvs)] body)) - (#Some [name #Nil #None body (record$ meta-kvs)]) + (#Some [name #Nil #None body meta-kvs]) (^ (list [_ (#Form (#Cons name args))] type body)) - (#Some [name args (#Some type) body (' {})]) + (#Some [name args (#Some type) body #Nil]) (^ (list name type body)) - (#Some [name #Nil (#Some type) body (' {})]) + (#Some [name #Nil (#Some type) body #Nil]) (^ (list [_ (#Form (#Cons name args))] body)) - (#Some [name args #None body (' {})]) + (#Some [name args #None body #Nil]) (^ (list name body)) - (#Some [name #Nil #None body (' {})]) + (#Some [name #Nil #None body #Nil]) _ #None))] @@ -3081,27 +3177,29 @@ (` (: (~ type) (~ body))) #None - body)] - (do Monad<Lux> - [=meta (process-def-meta meta)] - (return (list (` (;_lux_def (~ name) (~ body) (~ (with-func-args args - (case export? - #;None - =meta - - (#;Some (#;Left [])) - (with-export-meta =meta) - - (#;Some (#;Right [])) - (|> =meta - with-export-meta - with-hidden-meta) - ))))))))) + body) + =meta (process-def-meta meta)] + (return (list (` (;_lux_def (~ name) + (~ body) + [(~ cursor-code) + (#;Record (~ (with-func-args args + (case export? + #;None + =meta + + (#;Some (#;Left [])) + (with-export-meta =meta) + + (#;Some (#;Right [])) + (|> =meta + with-export-meta + with-hidden-meta) + ))))]))))) #None (fail "Wrong syntax for def")))) -(def: (meta-ast-add addition meta) +(def: (meta-code-add addition meta) (-> [Code Code] Code Code) (case [addition meta] [[name value] [cursor (#;Record pairs)]] @@ -3110,27 +3208,28 @@ _ meta)) -(def: (meta-ast-merge addition base) +(def: (meta-code-merge addition base) (-> Code Code Code) (case addition [cursor (#;Record pairs)] - (fold meta-ast-add base pairs) + (fold meta-code-add base pairs) _ base)) (macro:' #export (macro: tokens) - (list [["lux" "doc"] (#TextA "Macro-definition macro. + (list [(tag$ ["lux" "doc"]) + (text$ "Macro-definition macro. - (macro: #export (ident-for tokens) - (case tokens - (^template [<tag>] - (^ (list [_ (<tag> [prefix name])])) - (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))) - ([#;Symbol] [#;Tag]) + (macro: #export (ident-for tokens) + (case tokens + (^template [<tag>] + (^ (list [_ (<tag> [prefix name])])) + (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))) + ([#;Symbol] [#;Tag]) - _ - (fail \"Wrong syntax for ident-for\")))")]) + _ + (fail \"Wrong syntax for ident-for\")))")]) (let [[exported? tokens] (export-level^ tokens) name+args+meta+body?? (: (Maybe [Ident (List Code) Code Code]) (case tokens @@ -3156,8 +3255,8 @@ _ (` ((~ name) (~@ args))))] (return (list (` (;;def: (~@ (export-level exported?)) (~ def-sig) - (~ (meta-ast-merge (` {#;macro? true}) - meta)) + (~ (meta-code-merge (` {#;macro? true}) + meta)) ;;Macro (~ body)))))) @@ -3211,15 +3310,15 @@ _ (fail "Signatures require typed members!")))) - (List/join sigs'))) + (list/join sigs'))) #let [[_module _name] name+ def-name (symbol$ name) sig-type (record$ (map (: (-> [Text Code] [Code Code]) (function [[m-name m-type]] [(tag$ ["" m-name]) m-type])) members)) - sig-meta (meta-ast-merge (` {#;sig? true}) - meta) + sig-meta (meta-code-merge (` {#;sig? true}) + meta) usage (case args #;Nil def-name @@ -3466,7 +3565,7 @@ (#Right state module) _ - (#Left ($_ Text/compose "Unknown module: " name)))))) + (#Left ($_ text/compose "Unknown module: " name)))))) (def: get-current-module (Lux Module) @@ -3478,13 +3577,13 @@ (-> Ident (Lux [Nat (List Ident) Bool Type])) (do Monad<Lux> [=module (find-module module) - #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags-table #types types #module-anns _ #module-state _} =module]] + #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags-table #types types #module-annotations _ #module-state _} =module]] (case (get name tags-table) (#Some output) (return output) _ - (fail (Text/compose "Unknown tag: " (Ident/encode [module name])))))) + (fail (text/compose "Unknown tag: " (ident/encode [module name])))))) (def: (resolve-type-tags type) (-> Type (Lux (Maybe [(List Ident) (List Type)]))) @@ -3501,7 +3600,7 @@ (#Named [module name] unnamed) (do Monad<Lux> [=module (find-module module) - #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _ #module-state _} =module]] + #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} =module]] (case (get name types) (#Some [tags exported? (#Named _ _type)]) (case (resolve-struct-type _type) @@ -3557,16 +3656,16 @@ (wrap [tag value]) _ - (fail (Text/compose "Unknown structure member: " tag-name))) + (fail (text/compose "Unknown structure member: " tag-name))) _ (fail "Invalid structure member.")))) - (List/join tokens'))] + (list/join tokens'))] (wrap (list (record$ members))))) -(def: (Text/join parts) +(def: (text/join parts) (-> (List Text) Text) - (|> parts reverse (fold Text/compose ""))) + (|> parts reverse (fold text/compose ""))) (macro: #export (struct: tokens) {#;doc "## Definition of structures ala ML. @@ -3616,7 +3715,7 @@ #;None)) sig-args)) (^ (#;Some params)) - (#;Some (symbol$ ["" ($_ Text/compose sig-name "<" (|> params (interpose ",") Text/join) ">")])) + (#;Some (symbol$ ["" ($_ text/compose sig-name "<" (|> params (interpose ",") text/join) ">")])) _ #;None) @@ -3635,8 +3734,8 @@ _ (` ((~ name) (~@ args))))] (return (list (` (;;def: (~@ (export-level exported?)) (~ usage) - (~ (meta-ast-merge (` {#;struct? true}) - meta)) + (~ (meta-code-merge (` {#;struct? true}) + meta)) (~ type) (struct (~@ defs))))))) @@ -3686,38 +3785,34 @@ (^ (list [_ (#Symbol "" name)] [meta-cursor (#;Record meta-parts)] [type-cursor (#;Record type-parts)])) (#Some [name #Nil [meta-cursor (#;Record meta-parts)] (list [type-cursor (#;Record type-parts)])]) - (^ (list& [_ (#Symbol "" name)] [meta-cursor (#;Record meta-parts)] type-ast1 type-asts)) - (#Some [name #Nil [meta-cursor (#;Record meta-parts)] (#;Cons type-ast1 type-asts)]) + (^ (list& [_ (#Symbol "" name)] [meta-cursor (#;Record meta-parts)] type-code1 type-codes)) + (#Some [name #Nil [meta-cursor (#;Record meta-parts)] (#;Cons type-code1 type-codes)]) - (^ (list& [_ (#Symbol "" name)] type-asts)) - (#Some [name #Nil (` {}) type-asts]) + (^ (list& [_ (#Symbol "" name)] type-codes)) + (#Some [name #Nil (` {}) type-codes]) (^ (list [_ (#Form (#Cons [_ (#Symbol "" name)] args))] [meta-cursor (#;Record meta-parts)] [type-cursor (#;Record type-parts)])) (#Some [name args [meta-cursor (#;Record meta-parts)] (list [type-cursor (#;Record type-parts)])]) - (^ (list& [_ (#Form (#Cons [_ (#Symbol "" name)] args))] [meta-cursor (#;Record meta-parts)] type-ast1 type-asts)) - (#Some [name args [meta-cursor (#;Record meta-parts)] (#;Cons type-ast1 type-asts)]) + (^ (list& [_ (#Form (#Cons [_ (#Symbol "" name)] args))] [meta-cursor (#;Record meta-parts)] type-code1 type-codes)) + (#Some [name args [meta-cursor (#;Record meta-parts)] (#;Cons type-code1 type-codes)]) - (^ (list& [_ (#Form (#Cons [_ (#Symbol "" name)] args))] type-asts)) - (#Some [name args (` {}) type-asts]) + (^ (list& [_ (#Form (#Cons [_ (#Symbol "" name)] args))] type-codes)) + (#Some [name args (` {}) type-codes]) _ #None))] (case parts - (#Some name args meta type-asts) + (#Some name args meta type-codes) (do Monad<Lux> - [type+tags?? (unfold-type-def type-asts) + [type+tags?? (unfold-type-def type-codes) module-name current-module-name] (let [type-name (symbol$ ["" name]) [type tags??] type+tags?? type-meta (: Code (case tags?? (#Some tags) - (` {#;tags [(~@ (map (: (-> Text Code) - (function' [tag] - (form$ (list (tag$ ["lux" "TextA"]) - (text$ tag))))) - tags))] + (` {#;tags [(~@ (map text$ tags))] #;type? true}) _ @@ -3740,7 +3835,7 @@ (case type' (#Some type'') (return (list (` (;;def: (~@ (export-level exported?)) (~ type-name) - (~ ($_ meta-ast-merge (with-type-args args) + (~ ($_ meta-code-merge (with-type-args args) (if rec? (' {#;type-rec? true}) (' {})) type-meta meta)) @@ -3947,7 +4042,7 @@ #import-alias _alias #import-refer {#refer-defs _referrals #refer-open _openings}} importation] - {#import-name ($_ Text/compose super-name "/" _name) + {#import-name ($_ text/compose super-name "/" _name) #import-alias _alias #import-refer {#refer-defs _referrals #refer-open _openings}}))))) @@ -3962,19 +4057,19 @@ [current-module current-module-name] (case (split-module module) (^ (list& "." parts)) - (return (|> (list& current-module parts) (interpose "/") reverse (fold Text/compose ""))) + (return (|> (list& current-module parts) (interpose "/") reverse (fold text/compose ""))) parts - (let [[ups parts'] (split-with (Text/= "..") parts) + (let [[ups parts'] (split-with (text/= "..") parts) num-ups (length ups)] (if (i.= num-ups 0) (return module) (case (nth num-ups (split-module-contexts current-module)) #None - (fail (Text/compose "Cannot clean module: " module)) + (fail (text/compose "Cannot clean module: " module)) (#Some top-module) - (return (|> (list& top-module parts') (interpose "/") reverse (fold Text/compose "")))) + (return (|> (list& top-module parts') (interpose "/") reverse (fold text/compose "")))) ))) )) @@ -4037,9 +4132,9 @@ _ (do Monad<Lux> [current-module current-module-name] - (fail (Text/compose "Wrong syntax for import @ " current-module)))))) + (fail (text/compose "Wrong syntax for import @ " current-module)))))) imports)] - (wrap (List/join imports')))) + (wrap (list/join imports')))) (def: (exported-defs module state) (-> Text (Lux (List Text))) @@ -4056,17 +4151,17 @@ (function [[name [def-type def-meta def-value]]] (case [(get-meta ["lux" "export?"] def-meta) (get-meta ["lux" "hidden?"] def-meta)] - [(#Some (#BoolA true)) #;None] + [(#Some [_ (#Bool true)]) #;None] (list name) _ (list)))) - (let [{#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _ #module-state _} =module] + (let [{#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-annotations _ #module-state _} =module] defs))] - (#Right state (List/join to-alias))) + (#Right state (list/join to-alias))) #None - (#Left ($_ Text/compose "Unknown module: " module))) + (#Left ($_ text/compose "Unknown module: " module))) )) (def: (filter p xs) @@ -4084,7 +4179,7 @@ (-> (List Text) Text Bool) (let [output (fold (function [case prev] (or prev - (Text/= case name))) + (text/= case name))) false cases)] output)) @@ -4112,7 +4207,7 @@ #captured {#counter _ #mappings closure}} (try-both (find (: (-> [Text [Type Top]] (Maybe Type)) (function [[bname [type _]]] - (if (Text/= name bname) + (if (text/= name bname) (#Some type) #None)))) (: (List [Text [Type Top]]) locals) @@ -4130,7 +4225,7 @@ #None #None - (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _ #module-state _}) + (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-annotations _ #module-state _}) (case (get v-name defs) #None #None @@ -4147,12 +4242,12 @@ #scope-type-vars scope-type-vars} state] (case (get v-prefix modules) #None - (#Left (Text/compose "Unknown definition: " (Ident/encode name))) + (#Left (text/compose "Unknown definition: " (ident/encode name))) - (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _ #module-state _}) + (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-annotations _ #module-state _}) (case (get v-name defs) #None - (#Left (Text/compose "Unknown definition: " (Ident/encode name))) + (#Left (text/compose "Unknown definition: " (ident/encode name))) (#Some [def-type def-meta def-value]) (#Right [state [def-type def-value]]))))) @@ -4163,7 +4258,7 @@ [#let [[module name] ident] current-module current-module-name] (function [state] - (if (Text/= "" module) + (if (text/= "" module) (case (find-in-env name state) (#Some struct-type) (#Right state struct-type) @@ -4174,13 +4269,13 @@ (#Right state struct-type) _ - (#Left ($_ Text/compose "Unknown var: " (Ident/encode ident))))) + (#Left ($_ text/compose "Unknown var: " (ident/encode ident))))) (case (find-def-type ident state) (#Some struct-type) (#Right state struct-type) _ - (#Left ($_ Text/compose "Unknown var: " (Ident/encode ident))))) + (#Left ($_ text/compose "Unknown var: " (ident/encode ident))))) ))) (def: (zip2 xs ys) @@ -4206,7 +4301,7 @@ name _ - ($_ Text/compose "(" name " " (|> params (map Type/show) (interpose " ") reverse (fold Text/compose "")) ")")) + ($_ text/compose "(" name " " (|> params (map Type/show) (interpose " ") reverse (fold text/compose "")) ")")) #Void "Void" @@ -4215,38 +4310,38 @@ "Unit" (#Sum _) - ($_ Text/compose "(| " (|> (flatten-variant type) (map Type/show) (interpose " ") reverse (fold Text/compose "")) ")") + ($_ text/compose "(| " (|> (flatten-variant type) (map Type/show) (interpose " ") reverse (fold text/compose "")) ")") (#Product _) - ($_ Text/compose "[" (|> (flatten-tuple type) (map Type/show) (interpose " ") reverse (fold Text/compose "")) "]") + ($_ text/compose "[" (|> (flatten-tuple type) (map Type/show) (interpose " ") reverse (fold text/compose "")) "]") (#Function _) - ($_ Text/compose "(-> " (|> (flatten-lambda type) (map Type/show) (interpose " ") reverse (fold Text/compose "")) ")") + ($_ text/compose "(-> " (|> (flatten-lambda type) (map Type/show) (interpose " ") reverse (fold text/compose "")) ")") (#Bound id) - (Nat/encode id) + (nat/encode id) (#Var id) - ($_ Text/compose "⌈v:" (Nat/encode id) "⌋") + ($_ text/compose "⌈v:" (nat/encode id) "⌋") (#Ex id) - ($_ Text/compose "⟨e:" (Nat/encode id) "⟩") + ($_ text/compose "⟨e:" (nat/encode id) "⟩") (#UnivQ env body) - ($_ Text/compose "(All " (Type/show body) ")") + ($_ text/compose "(All " (Type/show body) ")") (#ExQ env body) - ($_ Text/compose "(Ex " (Type/show body) ")") + ($_ text/compose "(Ex " (Type/show body) ")") (#Apply _) (let [[func args] (flatten-app type)] - ($_ Text/compose + ($_ text/compose "(" (Type/show func) " " - (|> args (map Type/show) (interpose " ") reverse (fold Text/compose "")) + (|> args (map Type/show) (interpose " ") reverse (fold text/compose "")) ")")) (#Named [prefix name] _) - ($_ Text/compose prefix ";" name) + ($_ text/compose prefix ";" name) )) (def: (foldM Monad<m> f init inputs) @@ -4271,7 +4366,7 @@ struct-evidence (resolve-type-tags init-type)] (case struct-evidence #;None - (fail (Text/compose "Can only \"open\" structs: " (Type/show init-type))) + (fail (text/compose "Can only \"open\" structs: " (Type/show init-type))) (#;Some tags&members) (do Monad<Lux> @@ -4279,7 +4374,7 @@ (function recur [source [tags members] target] (let [pattern (record$ (map (function [[t-module t-name]] [(tag$ [t-module t-name]) - (symbol$ ["" (Text/compose prefix t-name)])]) + (symbol$ ["" (text/compose prefix t-name)])]) tags))] (do Monad<Lux> [enhanced-target (foldM Monad<Lux> @@ -4288,7 +4383,7 @@ [m-structure (resolve-type-tags m-type)] (case m-structure (#;Some m-tags&members) - (recur ["" (Text/compose prefix m-name)] + (recur ["" (text/compose prefix m-name)] m-tags&members enhanced-target) @@ -4413,11 +4508,11 @@ (: (-> [Ident Type] (Lux (List Code))) (function [[sname stype]] (open-field prefix sname source+ stype))) (zip2 tags members))] - (return (List/join decls'))) + (return (list/join decls'))) _ - (return (list (` (;_lux_def (~ (symbol$ ["" (Text/compose prefix name)])) (~ source+) - #Nil))))))) + (return (list (` (;_lux_def (~ (symbol$ ["" (text/compose prefix name)])) (~ source+) + [(~ cursor-code) (#;Record #Nil)]))))))) (macro: #export (open tokens) {#;doc "## Opens a structure and generates a definition for each of its members (including nested members). @@ -4447,34 +4542,34 @@ [decls' (mapM Monad<Lux> (: (-> [Ident Type] (Lux (List Code))) (function [[sname stype]] (open-field prefix sname source stype))) (zip2 tags members))] - (return (List/join decls'))) + (return (list/join decls'))) _ - (fail (Text/compose "Can only \"open\" structs: " (Type/show struct-type))))) + (fail (text/compose "Can only \"open\" structs: " (Type/show struct-type))))) _ (fail "Wrong syntax for open"))) (macro: #export (|>. tokens) {#;doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. - (|>. (map Int/encode) (interpose \" \") (fold Text/compose \"\")) + (|>. (map int/encode) (interpose \" \") (fold text/compose \"\")) ## => (function [<arg>] - (fold Text/compose \"\" + (fold text/compose \"\" (interpose \" \" - (map Int/encode <arg>))))"} + (map int/encode <arg>))))"} (do Monad<Lux> [g!arg (gensym "arg")] (return (list (` (function [(~ g!arg)] (|> (~ g!arg) (~@ tokens)))))))) (macro: #export (<|. tokens) {#;doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. - (<|. (fold Text/compose \"\") (interpose \" \") (map Int/encode)) + (<|. (fold text/compose \"\") (interpose \" \") (map int/encode)) ## => (function [<arg>] - (fold Text/compose \"\" + (fold text/compose \"\" (interpose \" \" - (map Int/encode <arg>))))"} + (map int/encode <arg>))))"} (do Monad<Lux> [g!arg (gensym "arg")] (return (list (` (function [(~ g!arg)] (<| (~@ tokens) (~ g!arg)))))))) @@ -4483,7 +4578,7 @@ (-> Text Text (Lux Bool)) (do Monad<Lux> [module (find-module module-name) - #let [{#module-hash _ #module-aliases _ #defs _ #imports imports #tags _ #types _ #module-anns _ #module-state _} module]] + #let [{#module-hash _ #module-aliases _ #defs _ #imports imports #tags _ #types _ #module-annotations _ #module-state _} module]] (wrap (is-member? imports import-name)))) (def: (read-refer module-name options) @@ -4501,7 +4596,7 @@ (function [_def] (if (is-member? all-defs _def) (return []) - (fail ($_ Text/compose _def " is not defined in module " module-name " @ " current-module))))) + (fail ($_ text/compose _def " is not defined in module " module-name " @ " current-module))))) referred-defs)))]] (case options #;Nil @@ -4509,11 +4604,11 @@ #refer-open openings}) _ - (fail ($_ Text/compose "Wrong syntax for refer @ " current-module + (fail ($_ text/compose "Wrong syntax for refer @ " current-module "\n" (|> options - (map ast-to-text) + (map code-to-text) (interpose " ") - (fold Text/compose ""))))))) + (fold text/compose ""))))))) (def: (write-refer module-name [r-defs r-opens]) (-> Text Refer (Lux (List Code))) @@ -4526,7 +4621,7 @@ (function [_def] (if (is-member? all-defs _def) (return []) - (fail ($_ Text/compose _def " is not defined in module " module-name " @ " current-module))))) + (fail ($_ text/compose _def " is not defined in module " module-name " @ " current-module))))) referred-defs)))] defs' (case r-defs #All @@ -4550,15 +4645,17 @@ (function [def] (` (;_lux_def (~ (symbol$ ["" def])) (~ (symbol$ [module-name def])) - (#Cons [["lux" "alias"] (#IdentA [(~ (text$ module-name)) (~ (text$ def))])] - #Nil))))) + [(~ cursor-code) + (#;Record (#Cons [[(~ cursor-code) (#;Tag ["lux" "alias"])] + [(~ cursor-code) (#;Symbol [(~ (text$ module-name)) (~ (text$ def))])]] + #Nil))])))) defs') openings (join-map (: (-> Openings (List Code)) (function [[prefix structs]] (map (function [[_ name]] (` (open (~ (symbol$ [module-name name])) (~ (text$ prefix))))) structs))) r-opens)]] - (wrap (List/compose defs openings)) + (wrap (list/compose defs openings)) )) (macro: #hidden (refer tokens) @@ -4571,7 +4668,7 @@ _ (fail "Wrong syntax for refer"))) -(def: (refer-to-ast module-name [r-defs r-opens]) +(def: (refer-to-code module-name [r-defs r-opens]) (-> Text Refer Code) (let [=defs (: (List Code) (case r-defs @@ -4604,23 +4701,23 @@ (;module: {#;doc \"Some documentation...\"} lux (lux (control (monad #as M #refer #all)) - (data (text #open (\"Text/\" Monoid<Text>)) - (coll (list #open (\"List/\" Monad<List>))) + (data (text #open (\"text/\" Monoid<Text>)) + (coll (list #open (\"list/\" Monad<List>))) maybe - (ident #open (\"Ident/\" Codec<Text,Ident>))) + (ident #open (\"ident/\" Codec<Text,Ident>))) meta - (macro ast)) + (macro code)) (.. (type #open (\"\" Eq<Type>)))) (;module: {#;doc \"Some documentation...\"} lux (lux (control [\"M\" monad #*]) - (data [text \"Text/\" Monoid<Text>] - (coll [list \"List/\" Monad<List>]) + (data [text \"text/\" Monoid<Text>] + (coll [list \"list/\" Monad<List>]) maybe - [ident \"Ident/\" Codec<Text,Ident>]) + [ident \"ident/\" Codec<Text,Ident>]) meta - (macro ast)) + (macro code)) (.. [type \"\" Eq<Type>]))"} (do Monad<Lux> [#let [[_meta _imports] (: [(List [Code Code]) (List Code)] @@ -4637,11 +4734,12 @@ imports) =refers (map (: (-> Importation Code) (function [[m-name m-alias =refer]] - (refer-to-ast m-name =refer))) - imports)] - =meta (process-def-meta (record$ (list& [(` #;imports) (` [(~@ =imports)])] - _meta))) - #let [=module (` (;_lux_module (~ =meta)))]] + (refer-to-code m-name =refer))) + imports) + =meta (process-def-meta (list& [(` #;imports) (` [(~@ =imports)])] + _meta)) + =module (` (;_lux_module [(~ cursor-code) + (#;Record (~ =meta))]))]] (wrap (#;Cons =module =refers)))) (macro: #export (:: tokens) @@ -4728,7 +4826,7 @@ (#;Cons (list new-binding old-record) accesses')])) [record (: (List (List Code)) #;Nil)] pairs) - accesses (List/join (reverse accesses'))]] + accesses (list/join (reverse accesses'))]] (wrap (list (` (let [(~@ accesses)] (~ update-expr))))))) @@ -4824,7 +4922,7 @@ (-> (List Type) Type Type) (case type (#;Host name params) - (#;Host name (List/map (beta-reduce env) params)) + (#;Host name (list/map (beta-reduce env) params)) (^template [<tag>] (<tag> left right) @@ -4870,7 +4968,7 @@ wrap)) #;None))) (#Some output) - (return (List/compose output branches)) + (return (list/compose output branches)) #None (fail "Wrong syntax for ^template")) @@ -4887,9 +4985,9 @@ [int-to-frac Int Frac ["int" "to-frac"]] ) -(def: (find-baseline-column ast) +(def: (find-baseline-column code) (-> Code Nat) - (case ast + (case code (^template [<tag>] [[_ _ column] (<tag> _)] column) @@ -4910,7 +5008,7 @@ [[_ _ column] (#Record pairs)] (fold n.min column - (List/compose (map (. find-baseline-column first) pairs) + (list/compose (map (. find-baseline-column first) pairs) (map (. find-baseline-column second) pairs))) )) @@ -4918,16 +5016,16 @@ (#Doc-Comment Text) (#Doc-Example Code)) -(def: (identify-doc-fragment ast) +(def: (identify-doc-fragment code) (-> Code Doc-Fragment) - (case ast + (case code [_ (#;Text comment)] (#Doc-Comment comment) _ - (#Doc-Example ast))) + (#Doc-Example code))) -(def: (Text/encode original) +(def: (text/encode original) (-> Text Text) (let [escaped (|> original (replace-all "\t" "\\t") @@ -4939,7 +5037,7 @@ (replace-all "\"" "\\\"") (replace-all "\\" "\\\\") )] - ($_ Text/compose "\"" escaped "\""))) + ($_ text/compose "\"" escaped "\""))) (do-template [<name> <op> <one> <type> <doc>] [(def: #export (<name> value) @@ -4953,9 +5051,9 @@ [n.dec n.- +1 Nat "[Nat] Decrement function."] ) -(def: Tag/encode +(def: tag/encode (-> Ident Text) - (. (Text/compose "#") Ident/encode)) + (. (text/compose "#") ident/encode)) (do-template [<name> <op> <from> <to>] [(def: #export (<name> input) @@ -4977,22 +5075,22 @@ (def: (cursor-padding baseline [_ old-line old-column] [_ new-line new-column]) (-> Nat Cursor Cursor Text) (if (n.= old-line new-line) - (Text/join (repeat (nat-to-int (n.- old-column new-column)) " ")) - (let [extra-lines (Text/join (repeat (nat-to-int (n.- old-line new-line)) "\n")) - space-padding (Text/join (repeat (nat-to-int (n.- baseline new-column)) " "))] - (Text/compose extra-lines space-padding)))) + (text/join (repeat (nat-to-int (n.- old-column new-column)) " ")) + (let [extra-lines (text/join (repeat (nat-to-int (n.- old-line new-line)) "\n")) + space-padding (text/join (repeat (nat-to-int (n.- baseline new-column)) " "))] + (text/compose extra-lines space-padding)))) -(def: (Text/size x) +(def: (text/size x) (-> Text Nat) (_lux_proc ["text" "size"] [x])) -(def: (Text/trim x) +(def: (text/trim x) (-> Text Text) (_lux_proc ["text" "trim"] [x])) -(def: (update-cursor [file line column] ast-text) +(def: (update-cursor [file line column] code-text) (-> Cursor Text Cursor) - [file line (n.+ column (Text/size ast-text))]) + [file line (n.+ column (text/size code-text))]) (def: (delim-update-cursor [file line column]) (-> Cursor Cursor) @@ -5000,7 +5098,7 @@ (def: rejoin-all-pairs (-> (List [Code Code]) (List Code)) - (. List/join (map rejoin-pair))) + (. list/join (map rejoin-pair))) (def: (doc-example->Text prev-cursor baseline example) (-> Cursor Nat Code [Cursor Text]) @@ -5009,25 +5107,25 @@ [new-cursor (<tag> value)] (let [as-text (<show> value)] [(update-cursor new-cursor as-text) - (Text/compose (cursor-padding baseline prev-cursor new-cursor) + (text/compose (cursor-padding baseline prev-cursor new-cursor) as-text)])) - ([#Bool Bool/encode] - [#Nat Nat/encode] - [#Int Int/encode] - [#Frac Frac/encode] - [#Text Text/encode] - [#Symbol Ident/encode] - [#Tag Tag/encode]) + ([#Bool bool/encode] + [#Nat nat/encode] + [#Int int/encode] + [#Frac frac/encode] + [#Text text/encode] + [#Symbol ident/encode] + [#Tag tag/encode]) (^template [<tag> <open> <close> <prep>] [group-cursor (<tag> parts)] (let [[group-cursor' parts-text] (fold (function [part [last-cursor text-accum]] (let [[part-cursor part-text] (doc-example->Text last-cursor baseline part)] - [part-cursor (Text/compose text-accum part-text)])) + [part-cursor (text/compose text-accum part-text)])) [(delim-update-cursor group-cursor) ""] (<prep> parts))] [(delim-update-cursor group-cursor') - ($_ Text/compose (cursor-padding baseline prev-cursor group-cursor) + ($_ text/compose (cursor-padding baseline prev-cursor group-cursor) <open> parts-text <close>)])) @@ -5049,14 +5147,14 @@ (#Doc-Comment comment) (|> comment (split-text "\n") - (map (function [line] ($_ Text/compose "## " line "\n"))) - Text/join) + (map (function [line] ($_ text/compose "## " line "\n"))) + text/join) (#Doc-Example example) (let [baseline (find-baseline-column example) [cursor _] example [_ text] (doc-example->Text (with-baseline baseline cursor) baseline example)] - (Text/compose text "\n\n")))) + (text/compose text "\n\n")))) (macro: #export (doc tokens) {#;doc "## Creates code documentation, embedding text as comments and properly formatting the forms it's being given. @@ -5069,11 +5167,12 @@ (if (< 10 count) (recur (i.inc count) (f x)) x)))"} - (return (list (` (#;TextA (~ (|> tokens + (return (list (` [(~ cursor-code) + (#;Text (~ (|> tokens (map (. doc-fragment->Text identify-doc-fragment)) - Text/join - Text/trim - text$))))))) + text/join + text/trim + text$)))])))) (def: (interleave xs ys) (All [a] (-> (List a) (List a) (List a))) @@ -5089,11 +5188,11 @@ (#Cons y ys') (list& x y (interleave xs' ys'))))) -(def: (type-to-ast type) +(def: (type-to-code type) (-> Type Code) (case type (#Host name params) - (` (#Host (~ (text$ name)) (~ (untemplate-list (map type-to-ast params))))) + (` (#Host (~ (text$ name)) (~ (untemplate-list (map type-to-code params))))) #Void (` #Void) @@ -5103,11 +5202,11 @@ (^template [<tag>] (<tag> left right) - (` (<tag> (~ (type-to-ast left)) (~ (type-to-ast right))))) + (` (<tag> (~ (type-to-code left)) (~ (type-to-code right))))) ([#Sum] [#Product]) (#Function in out) - (` (#Function (~ (type-to-ast in)) (~ (type-to-ast out)))) + (` (#Function (~ (type-to-code in)) (~ (type-to-code out)))) (#Bound idx) (` (#Bound (~ (nat$ idx)))) @@ -5119,18 +5218,18 @@ (` (#Ex (~ (nat$ id)))) (#UnivQ env type) - (let [env' (untemplate-list (map type-to-ast env))] - (` (#UnivQ (~ env') (~ (type-to-ast type))))) + (let [env' (untemplate-list (map type-to-code env))] + (` (#UnivQ (~ env') (~ (type-to-code type))))) (#ExQ env type) - (let [env' (untemplate-list (map type-to-ast env))] - (` (#ExQ (~ env') (~ (type-to-ast type))))) + (let [env' (untemplate-list (map type-to-code env))] + (` (#ExQ (~ env') (~ (type-to-code type))))) (#Apply arg fun) - (` (#Apply (~ (type-to-ast arg)) (~ (type-to-ast fun)))) + (` (#Apply (~ (type-to-code arg)) (~ (type-to-code fun)))) (#Named [module name] type) - (` (#Named [(~ (text$ module)) (~ (text$ name))] (~ (type-to-ast type)))) + (` (#Named [(~ (text$ module)) (~ (text$ name))] (~ (type-to-code type)))) )) (macro: #export (loop tokens) @@ -5154,8 +5253,8 @@ #None (fail "Wrong syntax for loop"))) init-types (mapM Monad<Lux> find-type inits') expected get-expected-type] - (return (list (` ((;_lux_: (-> (~@ (map type-to-ast init-types)) - (~ (type-to-ast expected))) + (return (list (` ((;_lux_: (-> (~@ (map type-to-code init-types)) + (~ (type-to-code expected))) (function (~ (symbol$ ["" "recur"])) [(~@ vars)] (~ body))) (~@ inits)))))) @@ -5218,8 +5317,8 @@ (#Some (list target)) [_ (#Symbol [prefix name])] - (if (and (Text/= "" prefix) - (Text/= label name)) + (if (and (text/= "" prefix) + (text/= label name)) (#Some tokens) (#Some (list target))) @@ -5227,7 +5326,7 @@ [_ (<tag> elems)] (do Monad<Maybe> [placements (mapM Monad<Maybe> (place-tokens label tokens) elems)] - (wrap (list (<ctor> (List/join placements)))))) + (wrap (list (<ctor> (list/join placements)))))) ([#Tuple tuple$] [#Form form$]) @@ -5334,13 +5433,13 @@ ["Text" Text text$]) _ - (fail (Text/compose "Cannot anti-quote type: " (Ident/encode name)))))) + (fail (text/compose "Cannot anti-quote type: " (ident/encode name)))))) (def: (anti-quote token) (-> Code (Lux Code)) (case token [_ (#Symbol [def-prefix def-name])] - (if (Text/= "" def-prefix) + (if (text/= "" def-prefix) (:: Monad<Lux> return token) (anti-quote-def [def-prefix def-name])) @@ -5437,7 +5536,7 @@ "Useful in situations where the result of a branch depends on further refinements on the values being matched." "For example:" (case (split (size static) uri) - (^multi (#;Some [chunk uri']) [(Text/= static chunk) true]) + (^multi (#;Some [chunk uri']) [(text/= static chunk) true]) (match-uri endpoint? parts' uri') _ @@ -5446,7 +5545,7 @@ "Short-cuts can be taken when using boolean tests." "The example above can be rewritten as..." (case (split (size static) uri) - (^multi (#;Some [chunk uri']) (Text/= static chunk)) + (^multi (#;Some [chunk uri']) (text/= static chunk)) (match-uri endpoint? parts' uri') _ @@ -5458,7 +5557,7 @@ expected get-expected-type g!temp (gensym "temp")] (let [output (list g!temp - (` (;_lux_case (;_lux_: (#;Apply (~ (type-to-ast expected)) Maybe) + (` (;_lux_case (;_lux_: (#;Apply (~ (type-to-code expected)) Maybe) (case (~ g!temp) (~@ (multi-level-case$ g!temp [mlc body])) @@ -5527,7 +5626,7 @@ "In the example below, +0 corresponds to the 'a' variable." (def: #export (from-list list) (All [a] (-> (List a) (Vector a))) - (List/fold add + (list/fold add (: (Vector ($ +0)) empty) list)))} @@ -5540,7 +5639,7 @@ (wrap (list (` (#Ex (~ (nat$ var-id)))))) #;None - (fail (Text/compose "Indexed-type does not exist: " (Nat/encode idx))))) + (fail (text/compose "Indexed-type does not exist: " (nat/encode idx))))) _ (fail "Wrong syntax for $"))) @@ -5559,7 +5658,7 @@ (macro: #export (^@ tokens) {#;doc (doc "Allows you to simultaneously bind and de-structure a value." (def: (hash (^@ set [Hash<a> _])) - (List/fold (function [elem acc] (n.+ (:: Hash<a> hash elem) acc)) + (list/fold (function [elem acc] (n.+ (:: Hash<a> hash elem) acc)) +0 (to-list set))))} (case tokens @@ -5595,7 +5694,7 @@ (^ (list expr)) (do Monad<Lux> [type get-expected-type] - (wrap (list (` (;_lux_:! (~ (type-to-ast type)) (~ expr)))))) + (wrap (list (` (;_lux_:! (~ (type-to-code type)) (~ expr)))))) _ (fail "Wrong syntax for :!!"))) @@ -5624,7 +5723,7 @@ (^ (list [_ (#;Symbol var-name)])) (do Monad<Lux> [var-type (find-type var-name)] - (wrap (list (type-to-ast var-type)))) + (wrap (list (type-to-code var-type)))) _ (fail "Wrong syntax for type-of"))) @@ -5739,7 +5838,7 @@ (list (` (~ (replace-syntax rep-env input-template))))]) (~ g!_) - (#;Left (~ (text$ (Text/compose "Wrong syntax for " name)))) + (#;Left (~ (text$ (text/compose "Wrong syntax for " name)))) ))))) )) diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index ac4db6606..7824446bd 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -154,7 +154,7 @@ (do Monad<Lux> [name (macro;normalize name) [_ annotations _] (macro;find-def name)] - (case (macro;get-ident-ann (ident-for <tag>) annotations) + (case (macro;get-tag-ann (ident-for <tag>) annotations) (#;Some actor-name) (wrap actor-name) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 1cbf9e665..1f787b8e4 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -5,7 +5,7 @@ (lux (control [monad #+ do Monad] [eq #+ Eq] codec - ["p" parser "p/" Monad<Parser>]) + ["p" parser "parser/" Monad<Parser>]) (data [bool] [text "text/" Eq<Text> Monoid<Text>] (text ["l" lexer]) @@ -14,9 +14,9 @@ ["R" result] [sum] [product] - (coll [list "L/" Fold<List> Monad<List>] - [vector #+ Vector vector "Vector/" Monad<Vector>] - ["d" dict])) + (coll [list "list/" Fold<List> Monad<List>] + [vector #+ Vector vector "vector/" Monad<Vector>] + [dict #+ Dict])) [macro #+ Monad<Lux> with-gensyms] (macro ["s" syntax #+ syntax:] [code] @@ -39,13 +39,13 @@ (#Number Number) (#String String) (#Array (Vector JSON)) - (#Object (d;Dict String JSON))) + (#Object (Dict String JSON))) (do-template [<name> <type>] [(type: #export <name> <type>)] [Array (Vector JSON)] - [Object (d;Dict String JSON)] + [Object (Dict String JSON)] ) (type: #export (Reader a) @@ -75,7 +75,7 @@ (wrap (list (` (: JSON #Null)))) [_ (#;Tuple members)] - (wrap (list (` (: JSON (#Array (vector (~@ (L/map wrapper members)))))))) + (wrap (list (` (: JSON (#Array (vector (~@ (list/map wrapper members)))))))) [_ (#;Record pairs)] (do Monad<Lux> @@ -88,7 +88,7 @@ _ (macro;fail "Wrong syntax for JSON object."))) pairs)] - (wrap (list (` (: JSON (#Object (d;from-list text;Hash<Text> (list (~@ pairs'))))))))) + (wrap (list (` (: JSON (#Object (dict;from-list text;Hash<Text> (list (~@ pairs'))))))))) _ (wrap (list token)) @@ -99,7 +99,7 @@ (-> JSON (R;Result (List String))) (case json (#Object obj) - (#R;Success (d;keys obj)) + (#R;Success (dict;keys obj)) _ (#R;Error ($_ text/compose "Cannot get the fields of a non-object.")))) @@ -109,7 +109,7 @@ (-> String JSON (R;Result JSON)) (case json (#Object obj) - (case (d;get key obj) + (case (dict;get key obj) (#;Some value) (#R;Success value) @@ -124,14 +124,14 @@ (-> String JSON JSON (R;Result JSON)) (case json (#Object obj) - (#R;Success (#Object (d;put key value obj))) + (#R;Success (#Object (dict;put key value obj))) _ (#R;Error ($_ text/compose "Cannot set field \"" key "\" of a non-object.")))) (do-template [<name> <tag> <type> <desc>] [(def: #export (<name> key json) - {#;doc (#;TextA ($_ text/compose "A JSON object field getter for " <desc> "."))} + {#;doc (code;text ($_ text/compose "A JSON object field getter for " <desc> "."))} (-> Text JSON (R;Result <type>)) (case (get key json) (#R;Success (<tag> value)) @@ -165,25 +165,25 @@ [(#Array xs) (#Array ys)] (and (n.= (vector;size xs) (vector;size ys)) - (L/fold (function [idx prev] - (and prev - (maybe;default false - (do maybe;Monad<Maybe> - [x' (vector;nth idx xs) - y' (vector;nth idx ys)] - (wrap (= x' y')))))) - true - (list;indices (vector;size xs)))) + (list/fold (function [idx prev] + (and prev + (maybe;default false + (do maybe;Monad<Maybe> + [x' (vector;nth idx xs) + y' (vector;nth idx ys)] + (wrap (= x' y')))))) + true + (list;indices (vector;size xs)))) [(#Object xs) (#Object ys)] - (and (n.= (d;size xs) (d;size ys)) - (L/fold (function [[xk xv] prev] - (and prev - (case (d;get xk ys) - #;None false - (#;Some yv) (= xv yv)))) - true - (d;entries xs))) + (and (n.= (dict;size xs) (dict;size ys)) + (list/fold (function [[xk xv] prev] + (and prev + (case (dict;get xk ys) + #;None false + (#;Some yv) (= xv yv)))) + true + (dict;entries xs))) _ false))) @@ -226,7 +226,7 @@ (do-template [<name> <type> <tag> <desc>] [(def: #export <name> - {#;doc (#;TextA ($_ text/compose "Reads a JSON value as " <desc> "."))} + {#;doc (code;text ($_ text/compose "Reads a JSON value as " <desc> "."))} (Reader <type>) (do p;Monad<Parser> [head any] @@ -245,7 +245,7 @@ (do-template [<test> <check> <type> <eq> <encoder> <tag> <desc> <pre>] [(def: #export (<test> test) - {#;doc (#;TextA ($_ text/compose "Asks whether a JSON value is a " <desc> "."))} + {#;doc (code;text ($_ text/compose "Asks whether a JSON value is a " <desc> "."))} (-> <type> (Reader Bool)) (do p;Monad<Parser> [head any] @@ -257,7 +257,7 @@ (fail ($_ text/compose "JSON value is not " <desc> "."))))) (def: #export (<check> test) - {#;doc (#;TextA ($_ text/compose "Ensures a JSON value is a " <desc> "."))} + {#;doc (code;text ($_ text/compose "Ensures a JSON value is a " <desc> "."))} (-> <type> (Reader Unit)) (do p;Monad<Parser> [head any] @@ -305,19 +305,19 @@ (def: #export (object parser) {#;doc "Parses a JSON object, assuming that every element can be parsed the same way."} - (All [a] (-> (Reader a) (Reader (d;Dict Text a)))) + (All [a] (-> (Reader a) (Reader (Dict Text a)))) (do p;Monad<Parser> [head any] (case head (#Object object) (case (do R;Monad<Result> [] - (|> (d;entries object) + (|> (dict;entries object) (monad;map @ (function [[key val]] (do @ [val (run val parser)] (wrap [key val])))) - (:: @ map (d;from-list text;Hash<Text>)))) + (:: @ map (dict;from-list text;Hash<Text>)))) (#R;Success table) (wrap table) @@ -334,12 +334,12 @@ [head any] (case head (#Object object) - (case (d;get field-name object) + (case (dict;get field-name object) (#;Some value) (case (run value parser) (#R;Success output) (function [tail] - (#R;Success [(#;Cons (#Object (d;remove field-name object)) + (#R;Success [(#;Cons (#Object (dict;remove field-name object)) tail) output])) @@ -367,15 +367,15 @@ (def: (show-array show-json elems) (-> (-> JSON Text) (-> Array Text)) ($_ text/compose "[" - (|> elems (Vector/map show-json) vector;to-list (text;join-with ",")) + (|> elems (vector/map show-json) vector;to-list (text;join-with ",")) "]")) (def: (show-object show-json object) (-> (-> JSON Text) (-> Object Text)) ($_ text/compose "{" (|> object - d;entries - (L/map (function [[key value]] ($_ text/compose (show-string key) ":" (show-json value)))) + dict;entries + (list/map (function [[key value]] ($_ text/compose (show-string key) ":" (show-json value)))) (text;join-with ",")) "}")) @@ -428,15 +428,15 @@ [signed? (l;this? "-") digits (l;many l;decimal) decimals (p;default "0" - (do @ - [_ (l;this ".")] - (l;many l;decimal))) + (do @ + [_ (l;this ".")] + (l;many l;decimal))) exp (p;default "" - (do @ - [mark (l;one-of "eE") - signed?' (l;this? "-") - offset (l;many l;decimal)] - (wrap ($_ text/compose mark (if signed?' "-" "") offset))))] + (do @ + [mark (l;one-of "eE") + signed?' (l;this? "-") + offset (l;many l;decimal)] + (wrap ($_ text/compose mark (if signed?' "-" "") offset))))] (case (frac/decode ($_ text/compose (if signed? "-" "") digits "." decimals exp)) (#R;Error message) (p;fail message) @@ -447,13 +447,13 @@ (def: escaped~ (l;Lexer Text) ($_ p;either - (p;after (l;this "\\t") (p/wrap "\t")) - (p;after (l;this "\\b") (p/wrap "\b")) - (p;after (l;this "\\n") (p/wrap "\n")) - (p;after (l;this "\\r") (p/wrap "\r")) - (p;after (l;this "\\f") (p/wrap "\f")) - (p;after (l;this "\\\"") (p/wrap "\"")) - (p;after (l;this "\\\\") (p/wrap "\\")))) + (p;after (l;this "\\t") (parser/wrap "\t")) + (p;after (l;this "\\b") (parser/wrap "\b")) + (p;after (l;this "\\n") (parser/wrap "\n")) + (p;after (l;this "\\r") (parser/wrap "\r")) + (p;after (l;this "\\f") (parser/wrap "\f")) + (p;after (l;this "\\\"") (parser/wrap "\"")) + (p;after (l;this "\\\\") (parser/wrap "\\")))) (def: string~ (l;Lexer String) @@ -491,7 +491,7 @@ (wrap (<prep> elems))))] [array~ Array "[" "]" (json~ []) vector;from-list] - [object~ Object "{" "}" (kv~ json~) (d;from-list text;Hash<Text>)] + [object~ Object "{" "}" (kv~ json~) (dict;from-list text;Hash<Text>)] ) (def: (json~' _) diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux index 32ec67ad2..1f76e833a 100644 --- a/stdlib/source/lux/data/text/lexer.lux +++ b/stdlib/source/lux/data/text/lexer.lux @@ -6,7 +6,8 @@ [product] [maybe] ["R" result] - (coll [list "L/" Functor<List>])))) + (coll [list])) + (macro [code]))) (type: Offset Nat) @@ -127,7 +128,7 @@ (do-template [<name> <bottom> <top> <desc>] [(def: #export <name> - {#;doc (#;TextA ($_ text/compose "Only lex " <desc> " characters."))} + {#;doc (code;text ($_ text/compose "Only lex " <desc> " characters."))} (Lexer Text) (range (char <bottom>) (char <top>)))] diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index d2fe35244..9f691c964 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -4,13 +4,13 @@ (control ["F" functor] ["A" applicative] ["M" monad #+ do Monad]) - (data (coll [list "L/" Monoid<List> Monad<List>]) - [number] - [text "T/" Monoid<Text> Eq<Text>] + (data [number] [product] - [ident "Ident/" Codec<Text,Ident>] + [ident "ident/" Codec<Text,Ident> Eq<Ident>] [maybe] - ["R" result]))) + ["R" result] + [text "text/" Monoid<Text> Eq<Text>] + (coll [list "list/" Monoid<List> Monad<List>])))) ## (type: (Lux a) ## (-> Compiler (R;Result [Compiler a]))) @@ -66,7 +66,7 @@ #;None (#;Cons [k' v] plist') - (if (T/= k k') + (if (text/= k k') (#;Some v) (get k plist')))) @@ -117,7 +117,7 @@ (#R;Success [state module]) _ - (#R;Error ($_ T/compose "Unknown module: " name))))) + (#R;Error ($_ text/compose "Unknown module: " name))))) (def: #export current-module-name (Lux Text) @@ -143,56 +143,62 @@ (def: #export (get-ann tag anns) {#;doc "Looks-up a particular annotation's value within the set of annotations."} - (-> Ident Anns (Maybe Ann-Value)) - (let [[p n] tag] - (case anns - (#;Cons [[p' n'] dmv] anns') - (if (and (T/= p p') - (T/= n n')) - (#;Some dmv) - (get-ann tag anns')) - - #;Nil - #;None))) + (-> Ident Code (Maybe Code)) + (case anns + [_ (#;Record anns)] + (loop [anns anns] + (case anns + (#;Cons [key value] anns') + (case key + [_ (#;Tag tag')] + (if (ident/= tag tag') + (#;Some value) + (recur anns')) + + _ + (recur anns')) + + #;Nil + #;None)) + + _ + #;None)) (do-template [<name> <tag> <type>] [(def: #export (<name> tag anns) - (-> Ident Anns (Maybe <type>)) + (-> Ident Code (Maybe <type>)) (case (get-ann tag anns) - (#;Some (<tag> value)) + (#;Some [_ (<tag> value)]) (#;Some value) _ #;None))] - [get-bool-ann #;BoolA Bool] - [get-int-ann #;IntA Int] - [get-frac-ann #;FracA Frac] - [get-text-ann #;TextA Text] - [get-ident-ann #;IdentA Ident] - [get-list-ann #;ListA (List Ann-Value)] - [get-dict-ann #;DictA (List [Text Ann-Value])] + [get-bool-ann #;Bool Bool] + [get-int-ann #;Int Int] + [get-frac-ann #;Frac Frac] + [get-text-ann #;Text Text] + [get-symbol-ann #;Symbol Ident] + [get-tag-ann #;Tag Ident] + [get-form-ann #;Form (List Code)] + [get-tuple-ann #;Tuple (List Code)] + [get-record-ann #;Record (List [Code Code])] ) (def: #export (get-doc anns) {#;doc "Looks-up a definition's documentation."} - (-> Anns (Maybe Text)) + (-> Code (Maybe Text)) (get-text-ann ["lux" "doc"] anns)) (def: #export (flag-set? flag-name anns) {#;doc "Finds out whether an annotation-as-a-flag is set (has value 'true')."} - (-> Ident Anns Bool) - (case (get-ann flag-name anns) - (#;Some (#;BoolA true)) - true - - _ - false)) + (-> Ident Code Bool) + (maybe;default false (get-bool-ann flag-name anns))) (do-template [<name> <tag> <desc>] [(def: #export <name> - {#;doc (#;TextA ($_ T/compose "Checks whether a definition is " <desc> "."))} - (-> Anns Bool) + {#;doc (code;text ($_ text/compose "Checks whether a definition is " <desc> "."))} + (-> Code Bool) (flag-set? (ident-for <tag>)))] [export? #;export? "exported"] @@ -205,28 +211,28 @@ ) (do-template [<name> <tag> <type>] - [(def: (<name> dmv) - (-> Ann-Value (Maybe <type>)) - (case dmv - (<tag> actual-value) + [(def: (<name> input) + (-> Code (Maybe <type>)) + (case input + [_ (<tag> actual-value)] (#;Some actual-value) _ #;None))] - [try-mlist #;ListA (List Ann-Value)] - [try-mtext #;TextA Text] + [parse-tuple #;Tuple (List Code)] + [parse-text #;Text Text] ) (do-template [<name> <tag> <desc>] [(def: #export (<name> anns) - {#;doc (#;TextA ($_ T/compose "Looks up the arguments of a " <desc> "."))} - (-> Anns (List Text)) + {#;doc (code;text ($_ text/compose "Looks up the arguments of a " <desc> "."))} + (-> Code (List Text)) (maybe;default (list) (do maybe;Monad<Maybe> [_args (get-ann (ident-for <tag>) anns) - args (try-mlist _args)] - (M;map @ try-mtext args))))] + args (parse-tuple _args)] + (M;map @ parse-text args))))] [func-args #;func-args "function"] [type-args #;type-args "parameterized type"] @@ -239,10 +245,10 @@ [$module (get module modules) [def-type def-anns def-value] (: (Maybe Def) (|> (: Module $module) (get@ #;defs) (get name)))] (if (and (macro? def-anns) - (or (export? def-anns) (T/= module this-module))) + (or (export? def-anns) (text/= module this-module))) (#;Some (:! Macro def-value)) - (case (get-ann ["lux" "alias"] def-anns) - (#;Some (#;IdentA [r-module r-name])) + (case (get-symbol-ann ["lux" "alias"] def-anns) + (#;Some [r-module r-name]) (find-macro' modules this-module r-module r-name) _ @@ -306,7 +312,7 @@ (do Monad<Lux> [expansion (macro args) expansion' (M;map Monad<Lux> expand expansion)] - (wrap (L/join expansion'))) + (wrap (list/join expansion'))) #;None (:: Monad<Lux> wrap (list syntax)))) @@ -327,23 +333,23 @@ (do Monad<Lux> [expansion (macro args) expansion' (M;map Monad<Lux> expand-all expansion)] - (wrap (L/join expansion'))) + (wrap (list/join expansion'))) #;None (do Monad<Lux> [parts' (M;map Monad<Lux> expand-all (list& (code;symbol name) args))] - (wrap (list (code;form (L/join parts'))))))) + (wrap (list (code;form (list/join parts'))))))) [_ (#;Form (#;Cons [harg targs]))] (do Monad<Lux> [harg+ (expand-all harg) targs+ (M;map Monad<Lux> expand-all targs)] - (wrap (list (code;form (L/compose harg+ (L/join (: (List (List Code)) targs+))))))) + (wrap (list (code;form (list/compose harg+ (list/join (: (List (List Code)) targs+))))))) [_ (#;Tuple members)] (do Monad<Lux> [members' (M;map Monad<Lux> expand-all members)] - (wrap (list (code;tuple (L/join members'))))) + (wrap (list (code;tuple (list/join members'))))) _ (:: Monad<Lux> wrap (list syntax)))) @@ -355,7 +361,7 @@ (-> Text (Lux Code)) (function [state] (#R;Success [(update@ #;seed n.inc state) - (code;symbol ["" ($_ T/compose "__gensym__" prefix (:: number;Codec<Text,Nat> encode (get@ #;seed state)))])]))) + (code;symbol ["" ($_ text/compose "__gensym__" prefix (:: number;Codec<Text,Nat> encode (get@ #;seed state)))])]))) (def: (get-local-symbol ast) (-> Code (Lux Text)) @@ -364,7 +370,7 @@ (:: Monad<Lux> wrap name) _ - (fail (T/compose "Code is not a local symbol: " (code;to-text ast))))) + (fail (text/compose "Code is not a local symbol: " (code;to-text ast))))) (macro: #export (with-gensyms tokens) {#;doc (doc "Creates new symbols and offers them to the body expression." @@ -380,9 +386,9 @@ (^ (list [_ (#;Tuple symbols)] body)) (do Monad<Lux> [symbol-names (M;map @ get-local-symbol symbols) - #let [symbol-defs (L/join (L/map (: (-> Text (List Code)) - (function [name] (list (code;symbol ["" name]) (` (gensym (~ (code;text name))))))) - symbol-names))]] + #let [symbol-defs (list/join (list/map (: (-> Text (List Code)) + (function [name] (list (code;symbol ["" name]) (` (gensym (~ (code;text name))))))) + symbol-names))]] (wrap (list (` (do Monad<Lux> [(~@ symbol-defs)] (~ body)))))) @@ -424,7 +430,7 @@ (-> Text (Lux Type)) (function [state] (let [test (: (-> [Text [Type Top]] Bool) - (|>. product;left (T/= name)))] + (|>. product;left (text/= name)))] (case (do maybe;Monad<Maybe> [scope (list;find (function [env] (or (list;any? test (: (List [Text [Type Top]]) @@ -442,7 +448,7 @@ (#R;Success [state var-type]) #;None - (#R;Error ($_ T/compose "Unknown variable: " name)))))) + (#R;Error ($_ text/compose "Unknown variable: " name)))))) (def: #export (find-def name) {#;doc "Looks-up a definition's whole data in the available modules (including the current one)."} @@ -457,7 +463,7 @@ (#R;Success [state _anns]) _ - (#R;Error ($_ T/compose "Unknown definition: " (Ident/encode name)))))) + (#R;Error ($_ text/compose "Unknown definition: " (ident/encode name)))))) (def: #export (find-def-type name) {#;doc "Looks-up a definition's type in the available modules (including the current one)."} @@ -488,7 +494,7 @@ (-> Text (Lux (List [Text Def]))) (function [state] (case (get module-name (get@ #;modules state)) - #;None (#R;Error ($_ T/compose "Unknown module: " module-name)) + #;None (#R;Error ($_ text/compose "Unknown module: " module-name)) (#;Some module) (#R;Success [state (get@ #;defs module)]) ))) @@ -558,12 +564,12 @@ (case (get name (get@ #;tags =module)) (#;Some [idx tag-list exported? type]) (if (or exported? - (T/= this-module-name module)) + (text/= this-module-name module)) (wrap [idx tag-list type]) - (fail ($_ T/compose "Cannot access tag: " (Ident/encode tag) " from module " this-module-name))) + (fail ($_ text/compose "Cannot access tag: " (ident/encode tag) " from module " this-module-name))) _ - (fail ($_ T/compose "Unknown tag: " (Ident/encode tag)))))) + (fail ($_ text/compose "Unknown tag: " (ident/encode tag)))))) (def: #export (tag-lists module) {#;doc "All the tag-lists defined in a module, with their associated types."} @@ -574,9 +580,9 @@ (wrap (|> (get@ #;types =module) (list;filter (function [[type-name [tag-list exported? type]]] (or exported? - (T/= this-module-name module)))) - (L/map (function [[type-name [tag-list exported? type]]] - [tag-list type])))))) + (text/= this-module-name module)))) + (list/map (function [[type-name [tag-list exported? type]]] + [tag-list type])))))) (def: #export locals {#;doc "All the local variables currently in scope, separated in different scopes."} @@ -588,10 +594,10 @@ (#;Some scopes) (#R;Success [state - (L/map (|>. (get@ [#;locals #;mappings]) - (L/map (function [[name [type _]]] - [name type]))) - scopes)])))) + (list/map (|>. (get@ [#;locals #;mappings]) + (list/map (function [[name [type _]]] + [name type]))) + scopes)])))) (def: #export (un-alias def-name) {#;doc "Given an aliased definition's name, returns the original definition being referenced."} @@ -599,8 +605,8 @@ (do Monad<Lux> [def-name (normalize def-name) [_ def-anns _] (find-def def-name)] - (case (get-ann (ident-for #;alias) def-anns) - (#;Some (#;IdentA real-def-name)) + (case (get-symbol-ann (ident-for #;alias) def-anns) + (#;Some real-def-name) (wrap real-def-name) _ @@ -631,19 +637,19 @@ token)) (do Monad<Lux> [output (<func> token) - #let [_ (L/map (. log! code;to-text) - output)]] + #let [_ (list/map (. log! code;to-text) + output)]] (wrap (list))) (^ (list token)) (do Monad<Lux> [output (<func> token) - #let [_ (L/map (. log! code;to-text) - output)]] + #let [_ (list/map (. log! code;to-text) + output)]] (wrap output)) _ - (fail ($_ T/compose "Wrong syntax for " <desc> "."))))] + (fail ($_ text/compose "Wrong syntax for " <desc> "."))))] [log-expand expand "log-expand"] [log-expand-all expand-all "log-expand-all"] diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 51333ddc3..4e431de82 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -1,18 +1,18 @@ (;module: lux - (lux [macro #+ Monad<Lux> with-gensyms] - (control ["M" monad #+ do Monad] + (lux [macro #+ with-gensyms] + (control [monad #+ do Monad] [eq #+ Eq] ["p" parser]) (data [bool] [number] - [text "Text/" Monoid<Text>] + [text "text/" Monoid<Text>] [ident] - (coll [list #* "" Functor<List> Fold<List> "List/" Monoid<List>]) + (coll [list "list/" Functor<List>]) [product] [maybe] ["R" result])) - (.. [code "Code/" Eq<Code>])) + (.. [code "code/" Eq<Code>])) ## [Utils] (def: (join-pairs pairs) @@ -29,8 +29,8 @@ ## [Utils] (def: (remaining-inputs asts) (-> (List Code) Text) - ($_ Text/compose "\nRemaining input: " - (|> asts (map code;to-text) (interpose " ") (text;join-with "")))) + ($_ text/compose "\nRemaining input: " + (|> asts (list/map code;to-text) (list;interpose " ") (text;join-with "")))) ## [Syntaxs] (def: #export any @@ -43,7 +43,7 @@ (do-template [<get-name> <type> <tag> <eq> <desc>] [(def: #export <get-name> - {#;doc (#;TextA ($_ Text/compose "Parses the next " <desc> " input Code."))} + {#;doc (code;text ($_ text/compose "Parses the next " <desc> " input Code."))} (Syntax <type>) (function [tokens] (case tokens @@ -51,7 +51,7 @@ (#R;Success [tokens' x]) _ - (#R;Error ($_ Text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))] + (#R;Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))] [ bool Bool #;Bool bool;Eq<Bool> "bool"] [ nat Nat #;Nat number;Eq<Nat> "nat"] @@ -69,7 +69,7 @@ (function [tokens] (case tokens (#;Cons [token tokens']) - (let [is-it? (Code/= ast token) + (let [is-it? (code/= ast token) remaining (if is-it? tokens' tokens)] @@ -84,9 +84,9 @@ (function [tokens] (case tokens (#;Cons [token tokens']) - (if (Code/= ast token) + (if (code/= ast token) (#R;Success [tokens' []]) - (#R;Error ($_ Text/compose "Expected a " (code;to-text ast) " but instead got " (code;to-text token) + (#R;Error ($_ text/compose "Expected a " (code;to-text ast) " but instead got " (code;to-text token) (remaining-inputs tokens)))) _ @@ -106,7 +106,7 @@ (do-template [<name> <tag> <desc>] [(def: #export <name> - {#;doc (#;TextA ($_ Text/compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))} + {#;doc (code;text ($_ text/compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))} (Syntax Text) (function [tokens] (case tokens @@ -114,7 +114,7 @@ (#R;Success [tokens' x]) _ - (#R;Error ($_ Text/compose "Cannot parse local " <desc> (remaining-inputs tokens))))))] + (#R;Error ($_ text/compose "Cannot parse local " <desc> (remaining-inputs tokens))))))] [local-symbol #;Symbol "symbol"] [ local-tag #;Tag "tag"] @@ -122,7 +122,7 @@ (do-template [<name> <tag> <desc>] [(def: #export (<name> p) - {#;doc (#;TextA ($_ Text/compose "Parse inside the contents of a " <desc> " as if they were the input Codes."))} + {#;doc (code;text ($_ text/compose "Parse inside the contents of a " <desc> " as if they were the input Codes."))} (All [a] (-> (Syntax a) (Syntax a))) (function [tokens] @@ -130,17 +130,17 @@ (#;Cons [[_ (<tag> members)] tokens']) (case (p members) (#R;Success [#;Nil x]) (#R;Success [tokens' x]) - _ (#R;Error ($_ Text/compose "Syntax was expected to fully consume " <desc> (remaining-inputs tokens)))) + _ (#R;Error ($_ text/compose "Syntax was expected to fully consume " <desc> (remaining-inputs tokens)))) _ - (#R;Error ($_ Text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))] + (#R;Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))] [ form #;Form "form"] [tuple #;Tuple "tuple"] ) (def: #export (record p) - {#;doc (#;TextA ($_ Text/compose "Parse inside the contents of a record as if they were the input Codes."))} + {#;doc (code;text ($_ text/compose "Parse inside the contents of a record as if they were the input Codes."))} (All [a] (-> (Syntax a) (Syntax a))) (function [tokens] @@ -148,10 +148,10 @@ (#;Cons [[_ (#;Record pairs)] tokens']) (case (p (join-pairs pairs)) (#R;Success [#;Nil x]) (#R;Success [tokens' x]) - _ (#R;Error ($_ Text/compose "Syntax was expected to fully consume record" (remaining-inputs tokens)))) + _ (#R;Error ($_ text/compose "Syntax was expected to fully consume record" (remaining-inputs tokens)))) _ - (#R;Error ($_ Text/compose "Cannot parse record" (remaining-inputs tokens)))))) + (#R;Error ($_ text/compose "Cannot parse record" (remaining-inputs tokens)))))) (def: #export end! {#;doc "Ensures there are no more inputs."} @@ -159,7 +159,7 @@ (function [tokens] (case tokens #;Nil (#R;Success [tokens []]) - _ (#R;Error ($_ Text/compose "Expected list of tokens to be empty!" (remaining-inputs tokens)))))) + _ (#R;Error ($_ text/compose "Expected list of tokens to be empty!" (remaining-inputs tokens)))))) (def: #export end? {#;doc "Checks whether there are no more inputs."} @@ -195,8 +195,8 @@ (#R;Success [real-inputs value]) _ - (#R;Error (Text/compose "Unconsumed inputs: " - (|> (map code;to-text unconsumed-inputs) + (#R;Error (text/compose "Unconsumed inputs: " + (|> (list/map code;to-text unconsumed-inputs) (text;join-with ", ")))))))) ## [Syntax] @@ -216,11 +216,11 @@ [interfaces (tuple (some (super-class-decl^ imports class-vars)))] [constructor-args (constructor-args^ imports class-vars)] [methods (some (overriden-method-def^ imports))]) - (let [def-code ($_ Text/compose "anon-class:" + (let [def-code ($_ text/compose "anon-class:" (spaced (list (super-class-decl$ (maybe;default object-super-class super)) - (with-brackets (spaced (map super-class-decl$ interfaces))) - (with-brackets (spaced (map constructor-arg$ constructor-args))) - (with-brackets (spaced (map (method-def$ id) methods))))))] + (with-brackets (spaced (list/map super-class-decl$ interfaces))) + (with-brackets (spaced (list/map constructor-arg$ constructor-args))) + (with-brackets (spaced (list/map (method-def$ id) methods))))))] (wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] [])))))))} (let [[exported? tokens] (case tokens (^ (list& [_ (#;Tag ["" "hidden"])] tokens')) @@ -247,23 +247,23 @@ (case ?parts (#;Some [name args meta body]) (with-gensyms [g!tokens g!body g!msg] - (do Monad<Lux> - [vars+parsers (M;map Monad<Lux> - (: (-> Code (Lux [Code Code])) - (function [arg] - (case arg - (^ [_ (#;Tuple (list var parser))]) - (wrap [var parser]) - - [_ (#;Symbol var-name)] - (wrap [(code;symbol var-name) (` any)]) - - _ - (macro;fail "Syntax pattern expects tuples or symbols.")))) - args) + (do macro;Monad<Lux> + [vars+parsers (monad;map @ + (: (-> Code (Lux [Code Code])) + (function [arg] + (case arg + (^ [_ (#;Tuple (list var parser))]) + (wrap [var parser]) + + [_ (#;Symbol var-name)] + (wrap [(code;symbol var-name) (` any)]) + + _ + (macro;fail "Syntax pattern expects tuples or symbols.")))) + args) #let [g!state (code;symbol ["" "*compiler*"]) g!end (code;symbol ["" ""]) - error-msg (code;text (Text/compose "Wrong syntax for " name)) + error-msg (code;text (text/compose "Wrong syntax for " name)) export-ast (: (List Code) (case exported? (#;Some #R;Error) (list (' #hidden)) @@ -281,7 +281,7 @@ (do ;;_Monad<Parser>_ [(~@ (join-pairs vars+parsers)) (~ g!end) end!] - ((~' wrap) (do Monad<Lux> + ((~' wrap) (do macro;Monad<Lux> [] (~ body)))))) (#R;Success [(~ g!tokens) (~ g!body)]) diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux index 33ca61b8b..460dabbf6 100644 --- a/stdlib/source/lux/macro/syntax/common/reader.lux +++ b/stdlib/source/lux/macro/syntax/common/reader.lux @@ -2,8 +2,8 @@ lux (lux (control monad ["p" parser]) - (data (coll [list "L/" Functor<List>]) - [ident "Ident/" Eq<Ident>] + (data (coll [list]) + [ident "ident/" Eq<Ident>] [product] [maybe]) [macro] @@ -74,32 +74,34 @@ tail (s;local (list tail) (flat-list^ []))] (wrap (#;Cons head tail)))))) -(def: list-meta^ - (Syntax (List Code)) - (s;form (do p;Monad<Parser> - [_ (s;this (' #lux;ListA))] - (flat-list^ [])))) +(do-template [<name> <type> <tag> <then>] + [(def: <name> + (Syntax <type>) + (<| s;tuple + (p;after s;any) + s;form + (do p;Monad<Parser> + [_ (s;this (' <tag>))] + <then>)))] -(def: text-meta^ - (Syntax Text) - (s;form (do p;Monad<Parser> - [_ (s;this (' #lux;TextA))] - s;text))) + [tuple-meta^ (List Code) #lux;Tuple (flat-list^ [])] + [text-meta^ Text #lux;Text s;text] + ) (def: (find-definition-args meta-data) (-> (List [Ident Code]) (List Text)) - (maybe;default (list) - (case (list;find (|>. product;left (Ident/= ["lux" "func-args"])) meta-data) - (^multi (#;Some [_ value]) - [(p;run (list value) list-meta^) - (#;Right [_ args])] - [(p;run args (p;some text-meta^)) - (#;Right [_ args])]) - (#;Some args) - - _ - #;None) - )) + (<| (maybe;default (list)) + (case (list;find (|>. product;left (ident/= ["lux" "func-args"])) meta-data) + (^multi (#;Some [_ value]) + [(p;run (list value) tuple-meta^) + (#;Right [_ args])] + [(p;run args (p;some text-meta^)) + (#;Right [_ args])]) + (#;Some args) + + _ + #;None) + )) (def: #export (definition compiler) {#;doc "A reader that first macro-expands and then analyses the input Code, to ensure it's a definition."} diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 0a1bb1d30..f62c35551 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -166,6 +166,8 @@ (#E;Error error) (test error false))) +(def: #hidden _code/text_ code;text) + (syntax: #export (context: description [body test^]) {#;doc (doc "Macro for definint tests." (context: "Simple macros and constructs" @@ -246,7 +248,7 @@ body)] (with-gensyms [g!test] (wrap (list (` (def: #export (~ g!test) - {#;;test (#;TextA (~ description))} + {#;;test (;;_code/text_ (~ description))} (IO Test) (io (~ body))))))))) diff --git a/stdlib/source/lux/type/object.lux b/stdlib/source/lux/type/object.lux index a7231d432..3ab6bee4e 100644 --- a/stdlib/source/lux/type/object.lux +++ b/stdlib/source/lux/type/object.lux @@ -145,8 +145,8 @@ (do Monad<Lux> [name (macro;normalize name) [_ annotations _] (macro;find-def name)] - (case [(macro;get-ident-ann (ident-for <name-tag>) annotations) - (macro;get-ident-ann (ident-for <parent-tag>) annotations)] + (case [(macro;get-tag-ann (ident-for <name-tag>) annotations) + (macro;get-tag-ann (ident-for <parent-tag>) annotations)] [(#;Some real-name) (#;Some parent)] (if (Ident/= no-parent parent) (wrap [real-name (list)]) diff --git a/stdlib/source/lux/type/opaque.lux b/stdlib/source/lux/type/opaque.lux index b162ae79b..b58e8d32e 100644 --- a/stdlib/source/lux/type/opaque.lux +++ b/stdlib/source/lux/type/opaque.lux @@ -2,11 +2,11 @@ lux (lux (control [applicative] [monad #+ do Monad] - ["p" parser "p/" Monad<Parser>]) + ["p" parser]) (data [text "text/" Eq<Text> Monoid<Text>] ["R" result] - (coll [list "L/" Functor<List> Monoid<List>])) - [macro #+ Monad<Lux>] + (coll [list "list/" Functor<List> Monoid<List>])) + [macro] (macro [code] ["s" syntax #+ syntax:] (syntax ["cs" common] @@ -51,7 +51,7 @@ (def: down-cast Text "@opaque") (def: up-cast Text "@repr") -(def: macro-anns Anns (list [["lux" "macro?"] (#;BoolA true)])) +(def: macro-anns Code (' {#;macro? true})) (def: representation-name (-> Text Text) @@ -60,9 +60,9 @@ (def: (install-casts' this-module-name name type-vars) (-> Text Text (List Text) (Lux Unit)) - (do Monad<Lux> + (do macro;Monad<Lux> [this-module (macro;find-module this-module-name) - #let [type-varsC (L/map code;local-symbol type-vars) + #let [type-varsC (list/map code;local-symbol type-vars) opaque-declaration (` ((~ (code;local-symbol name)) (~@ type-varsC))) representation-declaration (` ((~ (code;local-symbol (representation-name name))) (~@ type-varsC))) this-module (|> this-module @@ -96,7 +96,7 @@ (def: (un-install-casts' this-module-name) (-> Text (Lux Unit)) - (do Monad<Lux> + (do macro;Monad<Lux> [this-module (macro;find-module this-module-name) #let [this-module (|> this-module (update@ #;defs (remove down-cast)) @@ -124,7 +124,7 @@ ") because definitions like that already exist."))))) (syntax: #hidden (un-install-casts) - (do Monad<Lux> + (do macro;Monad<Lux> [this-module-name macro;current-module-name ?down-cast (macro;find-macro [this-module-name down-cast]) ?up-cast (macro;find-macro [this-module-name up-cast])] @@ -151,7 +151,7 @@ representation-type [primitives (p;some s;any)]) (let [hidden-name (code;local-symbol (representation-name name)) - type-varsC (L/map code;local-symbol type-vars) + type-varsC (list/map code;local-symbol type-vars) opaque-declaration (` ((~ (code;local-symbol name)) (~@ type-varsC))) representation-declaration (` ((~ hidden-name) (~@ type-varsC)))] (wrap (list& (` (type: (~@ (csw;export export)) (~ opaque-declaration) @@ -160,5 +160,5 @@ (` (type: (~@ (csw;export export)) (~ representation-declaration) (~ representation-type))) (` (install-casts (~ (code;local-symbol name)) [(~@ type-varsC)])) - (L/compose primitives - (list (` (un-install-casts)))))))) + (list/compose primitives + (list (` (un-install-casts)))))))) |