diff options
Diffstat (limited to 'lux-bootstrapper')
| -rw-r--r-- | lux-bootstrapper/src/lux/analyser.clj | 31 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/analyser/case.clj | 82 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/analyser/lux.clj | 31 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/analyser/module.clj | 229 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/analyser/record.clj | 6 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/base.clj | 15 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/compiler/cache.clj | 3 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/compiler/cache/ann.clj | 7 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/lexer.clj | 9 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/parser.clj | 3 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/type.clj | 48 |
11 files changed, 211 insertions, 253 deletions
diff --git a/lux-bootstrapper/src/lux/analyser.clj b/lux-bootstrapper/src/lux/analyser.clj index ce571cae8..7b6e009dd 100644 --- a/lux-bootstrapper/src/lux/analyser.clj +++ b/lux-bootstrapper/src/lux/analyser.clj @@ -15,28 +15,6 @@ [jvm :as &&jvm]))) ;; [Utils] -(defn analyse-variant+ [analyse exo-type ident values] - (|do [[module tag-name] (&/normalize ident) - [exported? wanted-type group idx] (&&module/find-tag module (str "#" tag-name)) - :let [is-last? (= idx (dec (&/|length group)))]] - (if (= 1 (&/|length group)) - (|do [_location &/location] - (analyse exo-type (&/T [_location (&/$Tuple values)]))) - (|case exo-type - (&/$Var id) - (|do [? (&type/bound? id)] - (if (or ? (&&/type-tag? module tag-name)) - (&&lux/analyse-variant analyse (&/$Right exo-type) idx is-last? values) - (|do [wanted-type* (&type/instantiate-inference wanted-type) - [[variant-type variant-location] variant-analysis] (&&/cap-1 (&&lux/analyse-variant analyse (&/$Left wanted-type*) idx is-last? values)) - _ (&type/check exo-type variant-type)] - (return (&/|list (&&/|meta exo-type variant-location variant-analysis)))))) - - _ - (&&lux/analyse-variant analyse (&/$Right exo-type) idx is-last? values) - )) - )) - (defn ^:private just-analyse [analyser syntax] (&type/with-var (fn [?var] @@ -86,10 +64,6 @@ (|do [_ (&type/check exo-type &type/Text)] (return (&/|list (&&/|meta exo-type location (&&/$text ?value))))) - (&/$Tag ?ident) - (&/with-analysis-meta location exo-type - (analyse-variant+ analyse exo-type ?ident &/$End)) - (&/$Variant (&/$Item [command-meta command] parameters)) (|case command (&/$Nat idx) @@ -97,9 +71,10 @@ (&/with-analysis-meta location exo-type (&&lux/analyse-variant analyse (&/$Right exo-type) (if ?right (inc idx) idx) ?right parameters*))) - (&/$Tag ?ident) + (&/$Identifier ?ident) (&/with-analysis-meta location exo-type - (analyse-variant+ analyse exo-type ?ident parameters)) + (|do [[normal-module normal-short] (&/normalize ?ident)] + (&&lux/analyse-variant+ analyse exo-type normal-module normal-short parameters))) _ (&/fail-with-loc (str "[Analyser Error] Unknown syntax: " (&/show-ast (&/T [(&/T ["" -1 -1]) token]))))) diff --git a/lux-bootstrapper/src/lux/analyser/case.clj b/lux-bootstrapper/src/lux/analyser/case.clj index 5d2bb020a..0f892a5ca 100644 --- a/lux-bootstrapper/src/lux/analyser/case.clj +++ b/lux-bootstrapper/src/lux/analyser/case.clj @@ -182,8 +182,9 @@ _ (&/fail-with-loc (str "[Type System] Not a type-function:\n" (&type/show-type type-fn) "\n")))) -(defn adjust-type* [up type] +(defn adjust-type* "(-> (List (, (Maybe (List Type)) Int Type)) Type (Lux Type))" + [up type] (|case type (&/$UnivQ _aenv _abody) (&type/with-var @@ -245,10 +246,38 @@ (&/fail-with-loc (str "[Pattern-matching Error] Cannot pattern-match against type: " (&type/show-type type))) )) -(defn adjust-type [type] +(defn adjust-type "(-> Type (Lux Type))" + [type] (adjust-type* &/$End type)) +(defn analyse-tuple-pattern [analyse-pattern pattern value-type ?members kont] + (|do [must-infer? (&type/unknown? value-type) + value-type* (if must-infer? + (|do [member-types (&/map% (fn [_] &type/create-var+) (&/|range (&/|length ?members)))] + (return (&type/fold-prod member-types))) + (adjust-type value-type))] + (|case value-type* + (&/$Product _) + (|let [num-elems (&/|length ?members) + [_shorter _tuple-types] (&type/tuple-types-for (&/|length ?members) value-type*)] + (if (= num-elems _shorter) + (|do [[=tests =kont] (&/fold (fn [kont* vm] + (|let [[v m] vm] + (|do [[=test [=tests =kont]] (analyse-pattern &/$None v m kont*)] + (return (&/T [(&/$Item =test =tests) =kont]))))) + (|do [=kont kont] + (return (&/T [&/$End =kont]))) + (&/|reverse (&/zip2 _tuple-types ?members)))] + (return (&/T [($TupleTestAC =tests) =kont]))) + (&/fail-with-loc (str "[Pattern-matching Error] Pattern-matching mismatch. Requires tuple[" (&/|length (&type/flatten-prod value-type*)) "]. Given tuple [" (&/|length ?members) "].\n" + " At: " (&/show-ast pattern) "\n" + "Expected type: " (&type/show-type value-type*) "\n" + " Actual type: " (&type/show-type value-type))))) + + _ + (&/fail-with-loc (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type)))))) + (defn ^:private analyse-pattern [var?? value-type pattern kont] (|let [[meta pattern*] pattern] (|case pattern* @@ -315,48 +344,15 @@ (&type/instantiate-inference rec-type) (return value-type)) _ (&type/check value-type rec-type*)] - (analyse-pattern &/$None rec-type* (&/T [meta (&/$Tuple rec-members)]) kont)) - - (&/$None) - (|do [must-infer? (&type/unknown? value-type) - value-type* (if must-infer? - (|do [member-types (&/map% (fn [_] &type/create-var+) (&/|range (&/|length ?members)))] - (return (&type/fold-prod member-types))) - (adjust-type value-type))] - (|case value-type* - (&/$Product _) - (|let [num-elems (&/|length ?members) - [_shorter _tuple-types] (&type/tuple-types-for (&/|length ?members) value-type*)] - (if (= num-elems _shorter) - (|do [[=tests =kont] (&/fold (fn [kont* vm] - (|let [[v m] vm] - (|do [[=test [=tests =kont]] (analyse-pattern &/$None v m kont*)] - (return (&/T [(&/$Item =test =tests) =kont]))))) - (|do [=kont kont] - (return (&/T [&/$End =kont]))) - (&/|reverse (&/zip2 _tuple-types ?members)))] - (return (&/T [($TupleTestAC =tests) =kont]))) - (&/fail-with-loc (str "[Pattern-matching Error] Pattern-matching mismatch. Requires tuple[" (&/|length (&type/flatten-prod value-type*)) "]. Given tuple [" (&/|length ?members) "].\n" - " At: " (&/show-ast pattern) "\n" - "Expected type: " (&type/show-type value-type*) "\n" - " Actual type: " (&type/show-type value-type))))) + (|case rec-members + (&/$Item singleton (&/$End)) + (analyse-pattern &/$None rec-type* singleton kont) _ - (&/fail-with-loc (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type))))))) + (analyse-tuple-pattern analyse-pattern pattern rec-type* rec-members kont))) - (&/$Tag ?ident) - (|do [[=module =name] (&&/resolved-ident ?ident) - must-infer? (&type/unknown? value-type) - [_exported? variant-type** group idx] (&module/find-tag =module (str "#" =name)) - variant-type (if must-infer? - (|do [variant-type* (&type/instantiate-inference variant-type**) - _ (&type/check value-type variant-type*)] - (return variant-type*)) - (return value-type)) - value-type* (adjust-type variant-type) - case-type (&type/sum-at idx value-type*) - [=test =kont] (analyse-pattern &/$None case-type unit-tuple kont)] - (return (&/T [($VariantTestAC (&/T [idx (&/|length group) =test])) =kont]))) + (&/$None) + (analyse-tuple-pattern analyse-pattern pattern value-type ?members kont))) (&/$Variant (&/$Item [_ (&/$Nat idx)] (&/$Item [_ (&/$Bit right?)] ?values))) (let [idx (if right? (inc idx) idx)] @@ -369,10 +365,10 @@ (analyse-pattern &/$None case-type (&/T [(&/T ["" -1 -1]) (&/$Tuple ?values)]) kont))] (return (&/T [($VariantTestAC (&/T [idx (&/|length (&type/flatten-sum value-type*)) =test])) =kont])))) - (&/$Variant (&/$Item [_ (&/$Tag ?ident)] ?values)) + (&/$Variant (&/$Item [_ (&/$Identifier ?ident)] ?values)) (|do [[=module =name] (&&/resolved-ident ?ident) must-infer? (&type/unknown? value-type) - [_exported? variant-type** group idx] (&module/find-tag =module (str "#" =name)) + [_exported? variant-type** group idx] (&module/find-tag =module =name) variant-type (if must-infer? (|do [variant-type* (&type/instantiate-inference variant-type**) _ (&type/check value-type variant-type*)] diff --git a/lux-bootstrapper/src/lux/analyser/lux.clj b/lux-bootstrapper/src/lux/analyser/lux.clj index 7bd83f931..6b90dc31e 100644 --- a/lux-bootstrapper/src/lux/analyser/lux.clj +++ b/lux-bootstrapper/src/lux/analyser/lux.clj @@ -245,6 +245,25 @@ (&/fail-with-loc (str err "\n" "[Analyser Error] Cannot create variant if the expected type is " (&type/show-type exo-type) " " idx " " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str ""))))))) ))) +(defn analyse-variant+ [analyse exo-type module tag-name values] + (|do [[exported? wanted-type group idx] (&&module/find-tag module tag-name) + :let [is-last? (= idx (dec (&/|length group)))]] + (if (= 1 (&/|length group)) + (|do [_location &/location] + (analyse exo-type (&/T [_location (&/$Tuple values)]))) + (|case exo-type + (&/$Var id) + (|do [? (&type/bound? id)] + (if (or ? (&&/type-tag? module tag-name)) + (analyse-variant analyse (&/$Right exo-type) idx is-last? values) + (|do [wanted-type* (&type/instantiate-inference wanted-type) + [[variant-type variant-location] variant-analysis] (&&/cap-1 (analyse-variant analyse (&/$Left wanted-type*) idx is-last? values)) + _ (&type/check exo-type variant-type)] + (return (&/|list (&&/|meta exo-type variant-location variant-analysis)))))) + + _ + (analyse-variant analyse (&/$Right exo-type) idx is-last? values))))) + (defn analyse-record [analyse exo-type ?elems] (|do [rec-members&rec-type (&&record/order-record ?elems)] (|case rec-members&rec-type @@ -362,13 +381,19 @@ =arg (&/with-attempt (&&/analyse-1 analyse ?input-t ?arg) (fn [err] - (&/fail-with-loc (str err "\n" "[Analyser Error] Argument expected: " (&type/show-type ?input-t)))))] + (&/fail-with-loc (str err "\n" + "[Analyser Error] Argument expected: " (&type/show-type ?input-t)))))] (return (&/T [=output-t (&/$Item =arg =args)]))) _ (&/fail-with-loc (str "[Analyser Error] Cannot apply a non-function: " (&type/show-type ?fun-type*)))) (fn [err] - (&/fail-with-loc (str err "\n" "[Analyser Error] Cannot apply function " (&type/show-type fun-type) " to args: " (->> ?args (&/|map &/show-ast) (&/|interpose " ") (&/fold str ""))))))) + (&/fail-with-loc (str err "\n" + "[Analyser Error] Cannot apply function " (&type/show-type fun-type) + " to args: " (->> ?args + (&/|map &/show-ast) + (&/|interpose " ") + (&/fold str ""))))))) )) (defn ^:private do-analyse-apply [analyse exo-type =fn ?args] @@ -392,7 +417,7 @@ ((&/fail-with-loc error) state))) module-name &/get-module-name ;; :let [[r-prefix r-name] real-name - ;; _ (when (= "module:" r-name) + ;; _ (when (or (= "\\" r-name)) ;; (->> macro-expansion ;; (&/|map (fn [ast] (str (&/show-ast ast) "\n"))) ;; (&/fold str "") diff --git a/lux-bootstrapper/src/lux/analyser/module.clj b/lux-bootstrapper/src/lux/analyser/module.clj index 0013a9173..8c3a83440 100644 --- a/lux-bootstrapper/src/lux/analyser/module.clj +++ b/lux-bootstrapper/src/lux/analyser/module.clj @@ -96,44 +96,6 @@ state) nil)))) -(defn define-alias [module name de-aliased] - (fn [state] - (|case (&/get$ &/$scopes state) - (&/$Item ?env (&/$End)) - (return* (->> state - (&/update$ &/$modules - (fn [ms] - (&/|update module - (fn [m] - (&/update$ $defs - #(&/|put name (&/$AliasG de-aliased) %) - m)) - ms)))) - nil) - - _ - ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global definition outside of a global environment: " (str module &/+name-separator+ name))) - state)))) - -(defn define [module name exported? def-type def-value] - (fn [state] - (|case (&/get$ &/$scopes state) - (&/$Item ?env (&/$End)) - (return* (->> state - (&/update$ &/$modules - (fn [ms] - (&/|update module - (fn [m] - (&/update$ $defs - #(&/|put name (&/$DefinitionG (&/T [exported? def-type def-value])) %) - m)) - ms)))) - nil) - - _ - ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global definition outside of a global environment: " (str module &/+name-separator+ name))) - state)))) - (defn type-def "(-> Text Text (Lux [Bit Type]))" [module name] @@ -289,6 +251,24 @@ " at module: " current-module)) state))))) +(defn find-global [module name] + (|do [current-module &/get-module-name] + (fn [state] + (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] + (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] + (|case $def + (&/$AliasG [?r-module ?r-name]) (return* state $def) + (&/$DefinitionG _) (return* state $def) + (&/$TypeG _) (return* state $def) + (&/$TagG _) (return* state $def) + (&/$SlotG _) (return* state $def)) + ((&/fail-with-loc (str "[Analyser Error @ find-def] Global does not exist: " (str module &/+name-separator+ name) + " at module: " current-module)) + state)) + ((&/fail-with-loc (str "[Analyser Error @ find-def] Module does not exist: " module + " at module: " current-module)) + state))))) + (do-template [<tag> <find!> <find>] (do (defn <find!> [module name] (|do [current-module &/get-module-name] @@ -356,6 +336,19 @@ &/$SlotG find-slot! find-slot ) +(defn if_not_defined [module name then] + (|do [exists? (&/try% (find-global module name))] + (|case exists? + (&/$Some _) + (fn [state] + ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global because the name is already taken." + "\n" "Module: " module + "\n" "Name: " name)) + state)) + + (&/$None) + then))) + (defn defined? [module name] (&/try-all% (&/|list (|do [_ (find-def! module name)] (return true)) @@ -389,43 +382,73 @@ (return (&/T [_module _hash])))) _imports))) -(defn define_tag [module name exported? type group index] - (fn [state] - (|case (&/get$ &/$scopes state) - (&/$Item ?env (&/$End)) - (return* (->> state - (&/update$ &/$modules - (fn [ms] - (&/|update module - (fn [m] - (&/update$ $defs - #(&/|put name (&/$TagG (&/T [exported? type group index])) %) - m)) - ms)))) - nil) - - _ - ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global tag outside of a global environment: " (str module &/+name-separator+ name))) - state)))) +(defn define-alias [module name de-aliased] + (if_not_defined + module name + (fn [state] + (|case (&/get$ &/$scopes state) + (&/$Item ?env (&/$End)) + (return* (->> state + (&/update$ &/$modules + (fn [ms] + (&/|update module + (fn [m] + (&/update$ $defs + #(&/|put name (&/$AliasG de-aliased) %) + m)) + ms)))) + nil) + + _ + ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global definition outside of a global environment: " (str module &/+name-separator+ name))) + state))))) -(defn define_slot [module name exported? type group index] - (fn [state] - (|case (&/get$ &/$scopes state) - (&/$Item ?env (&/$End)) - (return* (->> state - (&/update$ &/$modules - (fn [ms] - (&/|update module - (fn [m] - (&/update$ $defs - #(&/|put name (&/$SlotG (&/T [exported? type group index])) %) - m)) - ms)))) - nil) - - _ - ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global slot outside of a global environment: " (str module &/+name-separator+ name))) - state)))) +(defn define [module name exported? def-type def-value] + (if_not_defined + module name + (fn [state] + (|case (&/get$ &/$scopes state) + (&/$Item ?env (&/$End)) + (return* (->> state + (&/update$ &/$modules + (fn [ms] + (&/|update module + (fn [m] + (&/update$ $defs + #(&/|put name (&/$DefinitionG (&/T [exported? def-type def-value])) %) + m)) + ms)))) + nil) + + _ + ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global definition outside of a global environment: " (str module &/+name-separator+ name))) + state))))) + +(do-template [<name> <tag>] + (defn <name> [module name exported? type group index] + (if_not_defined + module name + (fn [state] + (|case (&/get$ &/$scopes state) + (&/$Item ?env (&/$End)) + (return* (->> state + (&/update$ &/$modules + (fn [ms] + (&/|update module + (fn [m] + (&/update$ $defs + #(&/|put name (<tag> (&/T [exported? type group index])) %) + m)) + ms)))) + nil) + + _ + ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global outside of a global environment: " (str module &/+name-separator+ name))) + state))))) + + define_tag &/$TagG + define_slot &/$SlotG + ) (defn declare-labels "(-> Text (List Text) Bit Type (Lux Null))" @@ -439,40 +462,42 @@ (if record? (&/map% (fn [idx+label-name] (|let [[index label-name] idx+label-name] - (define_slot module (str "#" label-name) was-exported? type label-names index))) + (define_slot module label-name was-exported? type label-names index))) (&/enumerate label-names)) (&/map% (fn [idx+label-name] (|let [[index label-name] idx+label-name] - (define_tag module (str "#" label-name) was-exported? type label-names index))) + (define_tag module label-name was-exported? type label-names index))) (&/enumerate label-names)))))) (defn define-type [module name exported? def-value record? labels] - (|case labels - (&/$End) - (define module name exported? &type/Type def-value) - - (&/$Item labelH labelT) - (|do [_ (declare-labels module record? labels exported? def-value)] - (fn [state] - (|case (&/get$ &/$scopes state) - (&/$Item ?env (&/$End)) - (return* (->> state - (&/update$ &/$modules - (fn [ms] - (&/|update module - (fn [m] - (&/update$ $defs - #(&/|put name (&/$TypeG (&/T [exported? def-value (if record? - (&/$Right (&/T [labelH labelT])) - (&/$Left (&/T [labelH labelT])))])) - %) - m)) - ms)))) - nil) - - _ - ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global definition outside of a global environment: " (str module &/+name-separator+ name))) - state)))))) + (if_not_defined + module name + (|case labels + (&/$End) + (define module name exported? &type/Type def-value) + + (&/$Item labelH labelT) + (|do [_ (declare-labels module record? labels exported? def-value)] + (fn [state] + (|case (&/get$ &/$scopes state) + (&/$Item ?env (&/$End)) + (return* (->> state + (&/update$ &/$modules + (fn [ms] + (&/|update module + (fn [m] + (&/update$ $defs + #(&/|put name (&/$TypeG (&/T [exported? def-value (if record? + (&/$Right (&/T [labelH labelT])) + (&/$Left (&/T [labelH labelT])))])) + %) + m)) + ms)))) + nil) + + _ + ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global definition outside of a global environment: " (str module &/+name-separator+ name))) + state))))))) (def defs (|do [module &/get-module-name] diff --git a/lux-bootstrapper/src/lux/analyser/record.clj b/lux-bootstrapper/src/lux/analyser/record.clj index 09fd8b988..ecdee63f6 100644 --- a/lux-bootstrapper/src/lux/analyser/record.clj +++ b/lux-bootstrapper/src/lux/analyser/record.clj @@ -17,10 +17,10 @@ (|do [module &/get-module-name] (return (&/$Some (&/T [module &/$End &type/Any])))) - (&/$Item [[_ (&/$Tag slot0)] _] _) + (&/$Item [[_ (&/$Identifier slot0)] _] _) (|do [[module name] (&&/resolved-ident slot0) _exported?&type&slots&_index (fn [lux] - (|case ((&&module/find-slot module (str "#" name)) lux) + (|case ((&&module/find-slot module name) lux) (&/$Left error) (&/$Right (&/T [lux &/$None])) @@ -39,7 +39,7 @@ (&/$Some [module slot-group slot-type]) (|do [=pairs (&/map% (fn [kv] (|case kv - [[_ (&/$Tag k)] v] + [[_ (&/$Identifier k)] v] (|do [=k (&&/resolved-ident k)] (return (&/T [(&/ident->text =k) v]))) diff --git a/lux-bootstrapper/src/lux/base.clj b/lux-bootstrapper/src/lux/base.clj index eca121b6c..ca779a82a 100644 --- a/lux-bootstrapper/src/lux/base.clj +++ b/lux-bootstrapper/src/lux/base.clj @@ -82,7 +82,6 @@ ("Frac" 1) ("Text" 1) ("Identifier" 1) - ("Tag" 1) ("Form" 1) ("Variant" 1) ("Tuple" 1)) @@ -613,6 +612,15 @@ (fn [state] (return* state state))) +(defn try% [action] + (fn [state] + (|case (action state) + ($Right output) + ($Right (T [state ($Some output)])) + + ($Left _) + ($Right (T [state $None]))))) + (defn try-all% [monads] (|case monads ($End) @@ -1248,11 +1256,6 @@ [_ ($Text ?value)] (str "\"" ?value "\"") - [_ ($Tag ?module ?tag)] - (if (.equals "" ?module) - (str "#" ?tag) - (str "#" ?module +name-separator+ ?tag)) - [_ ($Identifier ?module ?name)] (if (.equals "" ?module) ?name diff --git a/lux-bootstrapper/src/lux/compiler/cache.clj b/lux-bootstrapper/src/lux/compiler/cache.clj index b336ba6f0..931b6a165 100644 --- a/lux-bootstrapper/src/lux/compiler/cache.clj +++ b/lux-bootstrapper/src/lux/compiler/cache.clj @@ -68,9 +68,6 @@ (delete-all-module-files (new File (str output-dir-prefix f)))) nil)) -(defn make-tag [ident] - (&/T [(&/T ["" 0 0]) (&/$Tag ident)])) - (defn make-identifier [ident] (&/T [(&/T ["" 0 0]) (&/$Identifier ident)])) diff --git a/lux-bootstrapper/src/lux/compiler/cache/ann.clj b/lux-bootstrapper/src/lux/compiler/cache/ann.clj index 0f13e729b..c6afd5505 100644 --- a/lux-bootstrapper/src/lux/compiler/cache/ann.clj +++ b/lux-bootstrapper/src/lux/compiler/cache/ann.clj @@ -45,9 +45,6 @@ [_ (&/$Identifier ident)] (str "@" (serialize-ident ident) stop) - [_ (&/$Tag ident)] - (str "#" (serialize-ident ident) stop) - [_ (&/$Form elems)] (str "(" (serialize-seq serialize elems)) @@ -87,8 +84,7 @@ [_module _name] (.split ident* "\\." 2)] [(&/T [dummy-location (<tag> (&/T [_module _name]))]) input*]))) - ^:private deserialize-identifier "@" &/$Identifier - ^:private deserialize-tag "#" &/$Tag) + ^:private deserialize-identifier "@" &/$Identifier) (defn ^:private deserialize-seq [deserializer ^String input] (cond (.startsWith input nil-signal) @@ -122,7 +118,6 @@ (deserialize-frac input) (deserialize-text input) (deserialize-identifier input) - (deserialize-tag input) (deserialize-form input) (deserialize-variant input) (deserialize-tuple input) diff --git a/lux-bootstrapper/src/lux/lexer.clj b/lux-bootstrapper/src/lux/lexer.clj index 47c985f21..8fb992141 100644 --- a/lux-bootstrapper/src/lux/lexer.clj +++ b/lux-bootstrapper/src/lux/lexer.clj @@ -16,7 +16,6 @@ ("Frac" 1) ("Text" 1) ("Identifier" 1) - ("Tag" 1) ("Open_Paren" 0) ("Close_Paren" 0) ("Open_Bracket" 0) @@ -34,7 +33,7 @@ (return (&/T [meta ($Text content)])))) (def +ident-re+ - #"^([^0-9\[\]\{\}\(\)\s\"#.][^\[\]\{\}\(\)\s\"#.]*)") + #"^([^0-9\[\]\{\}\(\)\s\".][^\[\]\{\}\(\)\s\".]*)") ;; [Lexers] (def ^:private lex-white-space @@ -95,11 +94,6 @@ (|do [[meta ident] lex-ident] (return (&/T [meta ($Identifier ident)])))) -(def ^:private lex-tag - (|do [[meta _ _] (&reader/read-text "#") - [_ ident] lex-ident] - (return (&/T [meta ($Tag ident)])))) - (do-template [<name> <text> <tag>] (def <name> (|do [[meta _ _] (&reader/read-text <text>)] @@ -133,5 +127,4 @@ lex-int lex-text lex-identifier - lex-tag lex-delimiter))) diff --git a/lux-bootstrapper/src/lux/parser.clj b/lux-bootstrapper/src/lux/parser.clj index fa9d0a110..85ee9cf71 100644 --- a/lux-bootstrapper/src/lux/parser.clj +++ b/lux-bootstrapper/src/lux/parser.clj @@ -68,9 +68,6 @@ (&lexer/$Identifier ?ident) (return (&/|list (&/T [meta (&/$Identifier ?ident)]))) - (&lexer/$Tag ?ident) - (return (&/|list (&/T [meta (&/$Tag ?ident)]))) - (&lexer/$Open_Paren _) (|do [syntax (parse-form parse)] (return (&/|list (&/T [meta syntax])))) diff --git a/lux-bootstrapper/src/lux/type.clj b/lux-bootstrapper/src/lux/type.clj index e8d98fedf..aa2f8c9f2 100644 --- a/lux-bootstrapper/src/lux/type.clj +++ b/lux-bootstrapper/src/lux/type.clj @@ -121,54 +121,6 @@ (&/$Product Ident Type))))))))))) ))))) -(def Location - (&/$Named (&/T [&/prelude "Location"]) - (&/$Product Text (&/$Product Nat Nat)))) - -(def Meta - (&/$Named (&/T [&/prelude "Meta"]) - (&/$UnivQ empty-env - (&/$UnivQ empty-env - (&/$Product (&/$Parameter 3) - (&/$Parameter 1)))))) - -(def Code* - (&/$Named (&/T [&/prelude "Code'"]) - (let [Code (&/$Apply (&/$Apply (&/$Parameter 1) - (&/$Parameter 0)) - (&/$Parameter 1)) - Code-List (&/$Apply Code List)] - (&/$UnivQ empty-env - (&/$Sum ;; .Bit - Bit - (&/$Sum ;; .Nat - Nat - (&/$Sum ;; .Int - Int - (&/$Sum ;; .Rev - Rev - (&/$Sum ;; .Frac - Frac - (&/$Sum ;; .Text - Text - (&/$Sum ;; .Identifier - Ident - (&/$Sum ;; .Tag - Ident - (&/$Sum ;; .Form - Code-List - (&/$Sum ;; .Variant - Code-List - ;; .Tuple - Code-List - )))))))))) - )))) - -(def Code - (&/$Named (&/T [&/prelude "Code"]) - (let [w (&/$Apply Location Meta)] - (&/$Apply (&/$Apply w Code*) w)))) - (def Macro (&/$Named (&/T [&/prelude "Macro"]) (&/$Primitive "#Macro" &/$End))) |