diff options
Diffstat (limited to '')
44 files changed, 670 insertions, 656 deletions
diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj index abdd0acd7..af272fa91 100644 --- a/luxc/src/lux/analyser.clj +++ b/luxc/src/lux/analyser.clj @@ -22,8 +22,8 @@ group (&&module/tag-group module tag-name) :let [is-last? (= idx (dec (&/|length group)))]] (if (= 1 (&/|length group)) - (|do [_cursor &/cursor] - (analyse exo-type (&/T [_cursor (&/$Tuple values)]))) + (|do [_location &/location] + (analyse exo-type (&/T [_location (&/$Tuple values)]))) (|case exo-type (&/$Var id) (|do [? (&type/bound? id)] @@ -31,9 +31,9 @@ (&&lux/analyse-variant analyse (&/$Right exo-type) idx is-last? values) (|do [wanted-type (&&module/tag-type module tag-name) wanted-type* (&type/instantiate-inference wanted-type) - [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (&&lux/analyse-variant analyse (&/$Left wanted-type*) idx is-last? values)) + [[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-cursor variant-analysis)))))) + (return (&/|list (&&/|meta exo-type variant-location variant-analysis)))))) _ (&&lux/analyse-variant analyse (&/$Right exo-type) idx is-last? values) @@ -43,23 +43,23 @@ (defn ^:private just-analyse [analyser syntax] (&type/with-var (fn [?var] - (|do [[[?output-type ?output-cursor] ?output-term] (&&/analyse-1 analyser ?var syntax)] + (|do [[[?output-type ?output-location] ?output-term] (&&/analyse-1 analyser ?var syntax)] (|case [?var ?output-type] [(&/$Var ?e-id) (&/$Var ?a-id)] (if (= ?e-id ?a-id) (|do [=output-type (&type/clean ?var ?output-type)] - (return (&&/|meta =output-type ?output-cursor ?output-term))) + (return (&&/|meta =output-type ?output-location ?output-term))) (|do [=output-type (&type/clean ?var ?var)] - (return (&&/|meta =output-type ?output-cursor ?output-term)))) + (return (&&/|meta =output-type ?output-location ?output-term)))) [_ _] (|do [=output-type (&type/clean ?var ?output-type)] - (return (&&/|meta =output-type ?output-cursor ?output-term)))) + (return (&&/|meta =output-type ?output-location ?output-term)))) )))) (defn ^:private analyse-ast [optimize eval! compile-module ^"[Ljava.lang.Object;" compilers exo-type ?token] (|let [analyse (partial analyse-ast optimize eval! compile-module compilers) - [cursor token] ?token + [location token] ?token compile-def (aget compilers 0) compile-program (aget compilers 1) macro-caller (aget compilers 2)] @@ -67,42 +67,42 @@ ;; Standard special forms (&/$Bit ?value) (|do [_ (&type/check exo-type &type/Bit)] - (return (&/|list (&&/|meta exo-type cursor (&&/$bit ?value))))) + (return (&/|list (&&/|meta exo-type location (&&/$bit ?value))))) (&/$Nat ?value) (|do [_ (&type/check exo-type &type/Nat)] - (return (&/|list (&&/|meta exo-type cursor (&&/$nat ?value))))) + (return (&/|list (&&/|meta exo-type location (&&/$nat ?value))))) (&/$Int ?value) (|do [_ (&type/check exo-type &type/Int)] - (return (&/|list (&&/|meta exo-type cursor (&&/$int ?value))))) + (return (&/|list (&&/|meta exo-type location (&&/$int ?value))))) (&/$Rev ?value) (|do [_ (&type/check exo-type &type/Rev)] - (return (&/|list (&&/|meta exo-type cursor (&&/$rev ?value))))) + (return (&/|list (&&/|meta exo-type location (&&/$rev ?value))))) (&/$Frac ?value) (|do [_ (&type/check exo-type &type/Frac)] - (return (&/|list (&&/|meta exo-type cursor (&&/$frac ?value))))) + (return (&/|list (&&/|meta exo-type location (&&/$frac ?value))))) (&/$Text ?value) (|do [_ (&type/check exo-type &type/Text)] - (return (&/|list (&&/|meta exo-type cursor (&&/$text ?value))))) + (return (&/|list (&&/|meta exo-type location (&&/$text ?value))))) (&/$Tuple ?elems) - (&/with-analysis-meta cursor exo-type + (&/with-analysis-meta location exo-type (&&lux/analyse-tuple analyse (&/$Right exo-type) ?elems)) (&/$Record ?elems) - (&/with-analysis-meta cursor exo-type + (&/with-analysis-meta location exo-type (&&lux/analyse-record analyse exo-type ?elems)) (&/$Tag ?ident) - (&/with-analysis-meta cursor exo-type + (&/with-analysis-meta location exo-type (analyse-variant+ analyse exo-type ?ident &/$Nil)) (&/$Identifier ?ident) - (&/with-analysis-meta cursor exo-type + (&/with-analysis-meta location exo-type (&&lux/analyse-identifier analyse exo-type ?ident)) (&/$Form (&/$Cons [command-meta command] parameters)) @@ -113,7 +113,7 @@ (|let [(&/$Cons ?type (&/$Cons ?value (&/$Nil))) parameters] - (&/with-analysis-meta cursor exo-type + (&/with-analysis-meta location exo-type (&&lux/analyse-ann analyse eval! exo-type ?type ?value))) "lux check type" @@ -124,7 +124,7 @@ (|let [(&/$Cons ?type (&/$Cons ?value (&/$Nil))) parameters] - (&/with-analysis-meta cursor exo-type + (&/with-analysis-meta location exo-type (&&lux/analyse-coerce analyse eval! exo-type ?type ?value))) "lux def" @@ -134,7 +134,7 @@ (&/$Cons [_ (&/$Bit exported?)] (&/$Nil))) )) parameters] - (&/with-cursor cursor + (&/with-location location (&&lux/analyse-def analyse optimize eval! compile-def ?name ?value ?meta exported?))) "lux def alias" @@ -142,7 +142,7 @@ (&/$Cons [_ (&/$Identifier ?original)] (&/$Nil) )) parameters] - (&/with-cursor cursor + (&/with-location location (&&lux/analyse-def-alias ?alias ?original))) "lux def type tagged" @@ -153,27 +153,27 @@ (&/$Cons [_ (&/$Bit exported?)] (&/$Nil)))) )) parameters] - (&/with-cursor cursor + (&/with-location location (&&lux/analyse-def-type-tagged analyse optimize eval! compile-def ?name ?value ?meta ?tags exported?))) "lux def program" (|let [(&/$Cons ?program (&/$Nil)) parameters] - (&/with-cursor cursor + (&/with-location location (&&lux/analyse-program analyse optimize compile-program ?program))) "lux def module" (|let [(&/$Cons ?meta (&/$Cons ?imports (&/$Nil))) parameters] - (&/with-cursor cursor + (&/with-location location (&&lux/analyse-module analyse optimize eval! compile-module ?meta ?imports))) "lux in-module" (|let [(&/$Cons [_ (&/$Text ?module)] (&/$Cons ?expr (&/$Nil))) parameters] - (&/with-cursor cursor + (&/with-location location (&/with-module ?module (analyse exo-type ?expr)))) ;; else - (&/with-analysis-meta cursor exo-type + (&/with-analysis-meta location exo-type (cond (.startsWith ^String ?procedure "jvm") (|do [_ &/jvm-host] (&&jvm/analyse-host analyse exo-type compilers ?procedure parameters)) @@ -183,30 +183,30 @@ (&/$Nat idx) (|let [(&/$Cons [_ (&/$Bit ?right)] parameters*) parameters] - (&/with-analysis-meta cursor exo-type + (&/with-analysis-meta location exo-type (&&lux/analyse-variant analyse (&/$Right exo-type) (if ?right (inc idx) idx) ?right parameters*))) (&/$Tag ?ident) - (&/with-analysis-meta cursor exo-type + (&/with-analysis-meta location exo-type (analyse-variant+ analyse exo-type ?ident parameters)) ;; Pattern-matching syntax. (&/$Record ?pattern-matching) (|let [(&/$Cons ?input (&/$Nil)) parameters] - (&/with-analysis-meta cursor exo-type + (&/with-analysis-meta location exo-type (&&lux/analyse-case analyse exo-type ?input ?pattern-matching))) ;; Function syntax. (&/$Tuple (&/$Cons [_ (&/$Identifier "" ?self)] (&/$Cons [_ (&/$Identifier "" ?arg)] (&/$Nil)))) (|let [(&/$Cons ?body (&/$Nil)) parameters] - (&/with-analysis-meta cursor exo-type + (&/with-analysis-meta location exo-type (&&lux/analyse-function analyse exo-type ?self ?arg ?body))) _ - (&/with-cursor cursor + (&/with-location location (|do [=fn (just-analyse analyse (&/T [command-meta command]))] - (&&lux/analyse-apply analyse cursor exo-type macro-caller =fn parameters)))) + (&&lux/analyse-apply analyse location exo-type macro-caller =fn parameters)))) _ (&/fail-with-loc (str "[Analyser Error] Unknown syntax: " (&/show-ast (&/T [(&/T ["" -1 -1]) token])))) @@ -218,9 +218,9 @@ (&/flat-map% (partial analyse-ast optimize eval! compile-module compilers &type/Nothing) asts))) (defn clean-output [?var analysis] - (|do [:let [[[?output-type ?output-cursor] ?output-term] analysis] + (|do [:let [[[?output-type ?output-location] ?output-term] analysis] =output-type (&type/clean ?var ?output-type)] - (return (&&/|meta =output-type ?output-cursor ?output-term)))) + (return (&&/|meta =output-type ?output-location ?output-term)))) (defn repl-analyse [optimize eval! compile-module compilers] (|do [asts &parser/parse] diff --git a/luxc/src/lux/analyser/base.clj b/luxc/src/lux/analyser/base.clj index b6328c788..d6787280f 100644 --- a/luxc/src/lux/analyser/base.clj +++ b/luxc/src/lux/analyser/base.clj @@ -38,8 +38,8 @@ term)) (defn with-type [new-type analysis] - (|let [[[type cursor] adt] analysis] - (&/T [(&/T [new-type cursor]) adt]))) + (|let [[[type location] adt] analysis] + (&/T [(&/T [new-type location]) adt]))) (defn clean-analysis "(-> Type Analysis (Lux Analysis))" @@ -80,8 +80,8 @@ (and (= "lux" module) (contains? tag-names name)))) -(defn |meta [type cursor analysis] - (&/T [(&/T [type cursor]) analysis])) +(defn |meta [type location analysis] + (&/T [(&/T [type location]) analysis])) (defn de-meta "(-> Analysis Analysis)" diff --git a/luxc/src/lux/analyser/env.clj b/luxc/src/lux/analyser/env.clj index a6be49f98..a2b6e5ad3 100644 --- a/luxc/src/lux/analyser/env.clj +++ b/luxc/src/lux/analyser/env.clj @@ -14,7 +14,7 @@ (let [old-mappings (->> state (&/get$ &/$scopes) &/|head (&/get$ &/$locals) (&/get$ &/$mappings)) =return (body (&/update$ &/$scopes (fn [stack] - (let [var-analysis (&&/|meta type &/empty-cursor (&&/$var (&/$Local (->> (&/|head stack) (&/get$ &/$locals) (&/get$ &/$counter)))))] + (let [var-analysis (&&/|meta type &/empty-location (&&/$var (&/$Local (->> (&/|head stack) (&/get$ &/$locals) (&/get$ &/$counter)))))] (&/$Cons (&/update$ &/$locals #(->> % (&/update$ &/$counter inc) (&/update$ &/$mappings (fn [m] (&/|put name (&/T [type var-analysis]) m)))) @@ -42,9 +42,9 @@ (fn [stack] (&/$Cons (&/update$ &/$locals #(->> % (&/update$ &/$mappings (fn [m] (&/|put name - (&/T [(&&/expr-type* var-analysis) - var-analysis]) - m)))) + (&/T [(&&/expr-type* var-analysis) + var-analysis]) + m)))) (&/|head stack)) (&/|tail stack))) state))] diff --git a/luxc/src/lux/analyser/function.clj b/luxc/src/lux/analyser/function.clj index 68f5e89fe..3db24acef 100644 --- a/luxc/src/lux/analyser/function.clj +++ b/luxc/src/lux/analyser/function.clj @@ -17,8 +17,8 @@ (return (&/T [scope-name =captured =return])))))))) (defn close-over [scope name register frame] - (|let [[[register-type register-cursor] _] register - register* (&&/|meta register-type register-cursor + (|let [[[register-type register-location] _] register + register* (&&/|meta register-type register-location (&&/$captured (&/T [scope (->> frame (&/get$ &/$captured) (&/get$ &/$counter)) register])))] diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj index eb47ac039..fb2a2dd9e 100644 --- a/luxc/src/lux/analyser/lux.clj +++ b/luxc/src/lux/analyser/lux.clj @@ -46,9 +46,9 @@ ;; [Exports] (defn analyse-unit [analyse ?exo-type] - (|do [_cursor &/cursor + (|do [_location &/location _ (&type/check ?exo-type &type/Any)] - (return (&/|list (&&/|meta ?exo-type _cursor + (return (&/|list (&&/|meta ?exo-type _location (&&/$tuple (&/|list))))))) (defn analyse-tuple [analyse ?exo-type ?elems] @@ -73,7 +73,7 @@ (&type/with-var (fn [$var] (|do [exo-type** (&type/apply-type exo-type* $var) - [[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$Left exo-type**) ?elems)) + [[tuple-type tuple-location] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$Left exo-type**) ?elems)) =var (&type/resolve-type $var) inferred-type (|case =var (&/$Var iid) @@ -84,7 +84,7 @@ _ (&type/clean $var tuple-type))] - (return (&/|list (&&/|meta inferred-type tuple-cursor + (return (&/|list (&&/|meta inferred-type tuple-location tuple-analysis)))))) _ @@ -100,8 +100,8 @@ (&/$Cons last prevs) (&/fold (fn [right left] (&/$Product left right)) last prevs))) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$tuple =elems) )))) (|do [exo-type* (&type/actual-type exo-type)] @@ -115,8 +115,8 @@ (&&/analyse-1 analyse elem-t elem)) _tuple-types ?elems) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$tuple =elems) )))) (|do [=direct-elems (&/map2% (fn [elem-t elem] (&&/analyse-1 analyse elem-t elem)) @@ -125,8 +125,8 @@ =indirect-elems (analyse-tuple analyse (&/$Right (&/|last _tuple-types)) (&/|drop (dec _shorter) ?elems)) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$tuple (&/|++ =direct-elems =indirect-elems)) )))))) @@ -134,8 +134,8 @@ (&type/with-var (fn [$var] (|do [exo-type** (&type/apply-type exo-type* $var) - [[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$Right exo-type**) ?elems)) - =tuple-analysis (&&/clean-analysis $var (&&/|meta exo-type tuple-cursor + [[tuple-type tuple-location] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$Right exo-type**) ?elems)) + =tuple-analysis (&&/clean-analysis $var (&&/|meta exo-type tuple-location tuple-analysis))] (return (&/|list =tuple-analysis))))) @@ -143,9 +143,9 @@ (|do [$var &type/existential :let [(&/$Ex $var-id) $var] exo-type** (&type/apply-type exo-type* $var) - [[tuple-type tuple-cursor] tuple-analysis] (&/with-scope-type-var $var-id - (&&/cap-1 (analyse-tuple analyse (&/$Right exo-type**) ?elems)))] - (return (&/|list (&&/|meta exo-type tuple-cursor + [[tuple-type tuple-location] tuple-analysis] (&/with-scope-type-var $var-id + (&&/cap-1 (analyse-tuple analyse (&/$Right exo-type**) ?elems)))] + (return (&/|list (&&/|meta exo-type tuple-location tuple-analysis)))) _ @@ -156,7 +156,7 @@ )) (defn ^:private analyse-variant-body [analyse exo-type ?values] - (|do [_cursor &/cursor + (|do [_location &/location output (|case ?values (&/$Nil) (analyse-unit analyse exo-type) @@ -182,7 +182,7 @@ (&type/with-var (fn [$var] (|do [exo-type** (&type/apply-type exo-type* $var) - [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (analyse-variant analyse (&/$Left exo-type**) idx is-last? ?values)) + [[variant-type variant-location] variant-analysis] (&&/cap-1 (analyse-variant analyse (&/$Left exo-type**) idx is-last? ?values)) =var (&type/resolve-type $var) inferred-type (|case =var (&/$Var iid) @@ -193,7 +193,7 @@ _ (&type/clean $var variant-type))] - (return (&/|list (&&/|meta inferred-type variant-cursor + (return (&/|list (&&/|meta inferred-type variant-location variant-analysis)))))) _ @@ -214,10 +214,10 @@ (&/$Sum _) (|do [vtype (&type/sum-at idx exo-type*) =value (analyse-variant-body analyse vtype ?values) - _cursor &/cursor] + _location &/location] (if (= 1 (&/|length (&type/flatten-sum exo-type*))) (return (&/|list =value)) - (return (&/|list (&&/|meta exo-type _cursor (&&/$variant idx is-last? =value)))) + (return (&/|list (&&/|meta exo-type _location (&&/$variant idx is-last? =value)))) )) (&/$UnivQ _) @@ -250,10 +250,10 @@ (&/$Var id) (|do [? (&type/bound? id)] (if ? - (analyse-tuple analyse (&/$Right exo-type) rec-members) - (|do [[[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$Left rec-type) rec-members)) + (analyse-tuple analyse (&/$Right exo-type) rec-members) + (|do [[[tuple-type tuple-location] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$Left rec-type) rec-members)) _ (&type/check exo-type tuple-type)] - (return (&/|list (&&/|meta exo-type tuple-cursor + (return (&/|list (&&/|meta exo-type tuple-location tuple-analysis)))))) _ @@ -267,8 +267,8 @@ (&type/type= &type/Type exo-type)) (return nil) (&type/check exo-type endo-type)) - _cursor &/cursor] - (return (&/|list (&&/|meta endo-type _cursor + _location &/location] + (return (&/|list (&&/|meta endo-type _location (&&/$def (&/T [r-module r-name]))))))) (defn ^:private analyse-local [analyse exo-type name] @@ -325,7 +325,7 @@ (&/$Var ?id) (|do [? (&type/bound? ?id) type** (if ? - (&type/clean $var =output-t) + (&type/clean $var =output-t) (|do [_ (&type/set-var ?id (next-parameter-type =output-t)) cleaned-output* (&type/clean $var =output-t) :let [cleaned-output (&/$UnivQ &/$Nil cleaned-output*)]] @@ -344,7 +344,7 @@ (&/$Var ?id) (|do [? (&type/bound? ?id) type** (if ? - (&type/clean $var =output-t) + (&type/clean $var =output-t) (|do [idT &type/existential _ (&type/set-var ?id idT)] (&type/clean $var =output-t))) @@ -367,13 +367,13 @@ )) (defn ^:private do-analyse-apply [analyse exo-type =fn ?args] - (|do [:let [[[=fn-type =fn-cursor] =fn-form] =fn] + (|do [:let [[[=fn-type =fn-location] =fn-form] =fn] [=output-t =args] (analyse-apply* analyse exo-type =fn-type ?args)] - (return (&/|list (&&/|meta =output-t =fn-cursor + (return (&/|list (&&/|meta =output-t =fn-location (&&/$apply =fn =args) ))))) -(defn analyse-apply [analyse cursor exo-type macro-caller =fn ?args] +(defn analyse-apply [analyse location exo-type macro-caller =fn ?args] (|case =fn [_ (&&/$def ?module ?name)] (|do [[real-name [exported? ?type ?meta ?value]] (&&module/find-def! ?module ?name)] @@ -410,8 +410,8 @@ _ &/$None)] =match (&&case/analyse-branches analyse exo-type var?? (&&/expr-type* =value) ?branches) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$case =value =match) ))))) @@ -460,19 +460,19 @@ (&/$Var id) (|do [? (&type/bound? id)] (if ? - (|do [exo-type* (&type/deref id)] - (analyse-function* analyse exo-type* ?self ?arg ?body)) + (|do [exo-type* (&type/deref id)] + (analyse-function* analyse exo-type* ?self ?arg ?body)) ;; Inference (&type/with-var (fn [$input] (&type/with-var (fn [$output] - (|do [[[function-type function-cursor] function-analysis] (analyse-function* analyse (&/$Function $input $output) ?self ?arg ?body) + (|do [[[function-type function-location] function-analysis] (analyse-function* analyse (&/$Function $input $output) ?self ?arg ?body) =input (&type/resolve-type $input) =output (&type/resolve-type $output) inferred-type (clean-func-inference $input $output =input (embed-inferred-input =input =output)) _ (&type/check exo-type inferred-type)] - (return (&&/|meta inferred-type function-cursor + (return (&&/|meta inferred-type function-location function-analysis))) )))))) @@ -498,9 +498,9 @@ (|do [[=scope =captured =body] (&&function/with-function ?self exo-type* ?arg ?arg-t (&&/analyse-1 analyse ?return-t ?body)) - _cursor &/cursor + _location &/location register-offset &&env/next-local-idx] - (return (&&/|meta exo-type* _cursor + (return (&&/|meta exo-type* _location (&&/$function register-offset =scope =captured =body)))) _ @@ -517,14 +517,14 @@ exo-type* (&type/apply-type exo-type $var) [_ _expr] (&/with-scope-type-var $var-id (analyse-function** analyse exo-type* ?self ?arg ?body)) - _cursor &/cursor] - (return (&&/|meta exo-type _cursor _expr))) + _location &/location] + (return (&&/|meta exo-type _location _expr))) (&/$Var id) (|do [? (&type/bound? id)] (if ? - (|do [exo-type* (&type/actual-type exo-type)] - (analyse-function* analyse exo-type* ?self ?arg ?body)) + (|do [exo-type* (&type/actual-type exo-type)] + (analyse-function* analyse exo-type* ?self ?arg ?body)) ;; Inference (analyse-function* analyse exo-type ?self ?arg ?body))) @@ -689,8 +689,8 @@ (defn ^:private coerce "(-> Type Analysis Analysis)" [new-type analysis] - (|let [[[_type _cursor] _analysis] analysis] - (&&/|meta new-type _cursor + (|let [[[_type _location] _analysis] analysis] + (&&/|meta new-type _location _analysis))) (defn analyse-ann [analyse eval! exo-type ?type ?value] @@ -698,8 +698,8 @@ ==type (eval! =type) _ (&type/check exo-type ==type) =value (&&/analyse-1 analyse ==type ?value) - _cursor &/cursor] - (return (&/|list (&&/|meta ==type _cursor + _location &/location] + (return (&/|list (&&/|meta ==type _location (&&/$ann =value =type) ))))) diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index f055fc99c..8cdcea970 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -13,8 +13,8 @@ =reference (&&/analyse-1 analyse $var reference) =sample (&&/analyse-1 analyse $var sample) _ (&type/check exo-type &type/Bit) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["lux" "is"]) (&/|list =sample =reference) (&/|list))))))))) (defn- analyse-lux-try [analyse exo-type ?values] @@ -25,15 +25,15 @@ _ (&type/check exo-type (&/$Sum &type/Text ;; lux.Left $var ;; lux.Right )) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["lux" "try"]) (&/|list =op) (&/|list))))))))) (defn- analyse-lux-macro [analyse exo-type ?values] (|do [:let [(&/$Cons macro (&/$Nil)) ?values] - [[=macro*-type =cursor] =macro] (&&/analyse-1 analyse &type/Macro* macro) + [[=macro*-type =location] =macro] (&&/analyse-1 analyse &type/Macro* macro) _ (&type/check exo-type &type/Macro)] - (return (&/|list (&&/|meta exo-type =cursor + (return (&/|list (&&/|meta exo-type =location =macro))))) (do-template [<name> <proc> <input-type> <output-type>] @@ -42,8 +42,8 @@ =reference (&&/analyse-1 analyse <input-type> reference) =sample (&&/analyse-1 analyse <input-type> sample) _ (&type/check exo-type <output-type>) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T <proc>) (&/|list =sample =reference) (&/|list))))))) analyse-text-eq ["text" "="] &type/Text &type/Bit @@ -55,8 +55,8 @@ =parameter (&&/analyse-1 analyse &type/Text parameter) =subject (&&/analyse-1 analyse &type/Text subject) _ (&type/check exo-type &type/Text) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["text" "concat"]) (&/|list =parameter =subject) (&/|list))))))) (defn- analyse-text-index [analyse exo-type ?values] @@ -65,8 +65,8 @@ =part (&&/analyse-1 analyse &type/Text part) =text (&&/analyse-1 analyse &type/Text text) _ (&type/check exo-type (&/$Apply &type/Nat &type/Maybe)) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["text" "index"]) (&/|list =text =part =start) (&/|list))))))) @@ -77,8 +77,8 @@ =to (&&/analyse-1 analyse &type/Nat to) =text (&&/analyse-1 analyse &type/Text text) _ (&type/check exo-type &type/Text) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["text" "clip"]) (&/|list =text =from =to) (&/|list))))))) @@ -88,8 +88,8 @@ (|do [:let [(&/$Cons text (&/$Nil)) ?values] =text (&&/analyse-1 analyse &type/Text text) _ (&type/check exo-type &type/Nat) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["text" <proc>]) (&/|list =text) (&/|list))))))) @@ -102,8 +102,8 @@ =idx (&&/analyse-1 analyse &type/Nat idx) =text (&&/analyse-1 analyse &type/Text text) _ (&type/check exo-type &type/Nat) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["text" "char"]) (&/|list =text =idx) (&/|list))))))) @@ -116,8 +116,8 @@ =mask (&&/analyse-1 analyse inputT mask) =input (&&/analyse-1 analyse inputT input) _ (&type/check exo-type outputT) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["i64" <op>]) (&/|list =input =mask) (&/|list)))))))) analyse-i64-and "and" @@ -133,8 +133,8 @@ =shift (&&/analyse-1 analyse &type/Nat shift) =input (&&/analyse-1 analyse inputT input) _ (&type/check exo-type outputT) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["i64" <op>]) (&/|list =input =shift) (&/|list)))))))) analyse-i64-left-shift "left-shift" @@ -150,8 +150,8 @@ parameterA (&&/analyse-1 analyse <input-type> parameterC) subjectA (&&/analyse-1 analyse <input-type> subjectC) _ (&type/check exo-type <output-type>) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T <proc>) (&/|list subjectA parameterA) (&/|list)))))))) analyse-i64-eq ["i64" "="] (&/$Apply &type/Any &type/I64) &type/Bit @@ -177,8 +177,8 @@ (|do [:let [(&/$Cons x (&/$Nil)) ?values] =x (&&/analyse-1 analyse <type> x) _ (&type/check exo-type &type/Text) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T <encode-op>) (&/|list =x) (&/|list))))))) (let [decode-type (&/$Apply <type> &type/Maybe)] @@ -186,8 +186,8 @@ (|do [:let [(&/$Cons x (&/$Nil)) ?values] =x (&&/analyse-1 analyse &type/Text x) _ (&type/check exo-type decode-type) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T <decode-op>) (&/|list =x) (&/|list))))))))) analyse-frac-encode ["f64" "encode"] analyse-frac-decode ["f64" "decode"] &type/Frac @@ -197,8 +197,8 @@ (defn- <name> [analyse exo-type ?values] (|do [:let [(&/$Nil) ?values] _ (&type/check exo-type <type>) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T <op>) (&/|list) (&/|list))))))) analyse-frac-smallest &type/Frac ["f64" "smallest"] @@ -211,8 +211,8 @@ (|do [:let [(&/$Cons x (&/$Nil)) ?values] =x (&&/analyse-1 analyse <from-type> x) _ (&type/check exo-type <to-type>) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T <op>) (&/|list =x) (&/|list))))))) analyse-int-char &type/Int &type/Text ["i64" "char"] @@ -227,13 +227,13 @@ (defn- analyse-io-current-time [analyse exo-type ?values] (|do [:let [(&/$Nil) ?values] _ (&type/check exo-type &type/Int) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["io" "current-time"]) (&/|list) (&/|list))))))) (defn- analyse-syntax-char-case! [analyse exo-type ?values] (|do [:let [(&/$Cons ?input (&/$Cons [_ (&/$Tuple ?pairs)] (&/$Cons ?else (&/$Nil)))) ?values] - _cursor &/cursor + _location &/location =input (&&/analyse-1 analyse &type/Nat ?input) _ (assert! (even? (&/|length ?pairs)) "The number of matches must be even!") =pairs (&/map% (fn [?pair] @@ -246,10 +246,10 @@ =match]))))) (&/|as-pairs ?pairs)) =else (&&/analyse-1 analyse exo-type ?else)] - (return (&/|list (&&/|meta exo-type _cursor + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["lux" "syntax char case!"]) (&/|list =input - (&&/|meta exo-type _cursor (&&/$tuple (&/|map &/|second =pairs))) + (&&/|meta exo-type _location (&&/$tuple (&/|map &/|second =pairs))) =else) (&/|map &/|first =pairs))))))) diff --git a/luxc/src/lux/analyser/proc/jvm.clj b/luxc/src/lux/analyser/proc/jvm.clj index 74cf772be..cc77bf72c 100644 --- a/luxc/src/lux/analyser/proc/jvm.clj +++ b/luxc/src/lux/analyser/proc/jvm.clj @@ -85,8 +85,8 @@ (|let [(&/$Var id) gtype-var] (|do [? (&type/bound? id)] (if ? - (|do [real-type (&type/deref id)] - (return (&/T [idx real-type]))) + (|do [real-type (&type/deref id)] + (return (&/T [idx real-type]))) (return (&/T [(+ 2 idx) (&/$Parameter idx)])))))) (defn- clean-gtype-vars [gtype-vars] @@ -398,8 +398,8 @@ (|do [:let [(&/$Cons ?value (&/$Nil)) _?value] =value (&&/analyse-1 analyse (&/$Primitive <from-class> &/$Nil) ?value) _ (&type/check exo-type output-type) - _cursor &/cursor] - (return (&/|list (&&/|meta output-type _cursor (&&/$proc (&/T ["jvm" <proc>]) (&/|list =value) (&/|list)))))))) + _location &/location] + (return (&/|list (&&/|meta output-type _location (&&/$proc (&/T ["jvm" <proc>]) (&/|list =value) (&/|list)))))))) analyse-jvm-double-to-float "double-to-float" "java.lang.Double" "java.lang.Float" analyse-jvm-double-to-int "double-to-int" "java.lang.Double" "java.lang.Integer" @@ -439,8 +439,8 @@ =value1 (&&/analyse-1 analyse (&/$Primitive <v1-class> &/$Nil) ?value1) =value2 (&&/analyse-1 analyse (&/$Primitive <v2-class> &/$Nil) ?value2) _ (&type/check exo-type output-type) - _cursor &/cursor] - (return (&/|list (&&/|meta output-type _cursor (&&/$proc (&/T ["jvm" <proc>]) (&/|list =value1 =value2) (&/|list)))))))) + _location &/location] + (return (&/|list (&&/|meta output-type _location (&&/$proc (&/T ["jvm" <proc>]) (&/|list =value1 =value2) (&/|list)))))))) analyse-jvm-iand "iand" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer" analyse-jvm-ior "ior" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer" @@ -465,8 +465,8 @@ =x (&&/analyse-1 analyse input-type x) =y (&&/analyse-1 analyse input-type y) _ (&type/check exo-type output-type) - _cursor &/cursor] - (return (&/|list (&&/|meta output-type _cursor + _location &/location] + (return (&/|list (&&/|meta output-type _location (&&/$proc (&/T ["jvm" <proc>]) (&/|list =x =y) (&/|list)))))))) analyse-jvm-iadd "iadd" "java.lang.Integer" "java.lang.Integer" @@ -519,8 +519,8 @@ (|do [:let [(&/$Cons length (&/$Nil)) ?values] =length (&&/analyse-1 analyse length-type length) _ (&type/check exo-type array-type) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" <new-tag>]) (&/|list =length) (&/|list))))))) (defn- <load-name> [analyse exo-type ?values] @@ -528,8 +528,8 @@ =array (&&/analyse-1 analyse array-type array) =idx (&&/analyse-1 analyse idx-type idx) _ (&type/check exo-type elem-type) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" <load-tag>]) (&/|list =array =idx) (&/|list))))))) (defn- <store-name> [analyse exo-type ?values] @@ -538,8 +538,8 @@ =idx (&&/analyse-1 analyse idx-type idx) =elem (&&/analyse-1 analyse elem-type elem) _ (&type/check exo-type array-type) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" <store-tag>]) (&/|list =array =idx =elem) (&/|list))))))) ) @@ -571,8 +571,8 @@ :let [array-type (&/$Primitive &host-type/array-data-tag (&/|list =gclass))] =length (&&/analyse-1 analyse length-type length) _ (&type/check exo-type array-type) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" "anewarray"]) (&/|list =length) (&/|list gclass gtype-env))))))) (defn- analyse-jvm-aaload [analyse exo-type ?values] @@ -583,8 +583,8 @@ :let [(&/$Cons inner-arr-type (&/$Nil)) arr-params] =idx (&&/analyse-1 analyse idx-type idx) _ (&type/check exo-type inner-arr-type) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" "aaload"]) (&/|list =array =idx) (&/|list))))))) (defn- analyse-jvm-aastore [analyse exo-type ?values] @@ -597,8 +597,8 @@ =idx (&&/analyse-1 analyse idx-type idx) =elem (&&/analyse-1 analyse inner-arr-type elem) _ (&type/check exo-type array-type) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" "aastore"]) (&/|list =array =idx =elem) (&/|list)))))))) (defn- analyse-jvm-arraylength [analyse exo-type ?values] @@ -607,8 +607,8 @@ [arr-class arr-params] (ensure-object (&&/expr-type* =array)) _ (&/assert! (array-class? arr-class) (str "[Analyser Error] Expected array. Instead got: " arr-class)) _ (&type/check exo-type &type/Nat) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" "arraylength"]) (&/|list =array) (&/|list)) ))))) @@ -618,16 +618,16 @@ _ (ensure-object (&&/expr-type* =object)) :let [output-type &type/Bit] _ (&type/check exo-type output-type) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" "object null?"]) (&/|list =object) (&/|list))))))) (defn- analyse-jvm-object-null [analyse exo-type ?values] (|do [:let [(&/$Nil) ?values] :let [output-type (&/$Primitive &host-type/null-data-tag &/$Nil)] _ (&type/check exo-type output-type) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" "object null"]) (&/|list) (&/|list))))))) (defn analyse-jvm-object-synchronized [analyse exo-type ?values] @@ -635,8 +635,8 @@ =monitor (&&/analyse-1+ analyse ?monitor) _ (ensure-object (&&/expr-type* =monitor)) =expr (&&/analyse-1 analyse exo-type ?expr) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" "object synchronized"]) (&/|list =monitor =expr) (&/|list))))))) (defn- analyse-jvm-throw [analyse exo-type ?values] @@ -644,9 +644,9 @@ =ex (&&/analyse-1+ analyse ?ex) _ (&type/check (&/$Primitive "java.lang.Throwable" &/$Nil) (&&/expr-type* =ex)) [throw-class throw-params] (ensure-object (&&/expr-type* =ex)) - _cursor &/cursor + _location &/location _ (&type/check exo-type &type/Nothing)] - (return (&/|list (&&/|meta exo-type _cursor + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" "throw"]) (&/|list =ex) (&/|list))))))) (defn- analyse-jvm-getstatic [analyse exo-type class field ?values] @@ -657,8 +657,8 @@ =type (&host-type/instance-param &type/existential &/$Nil gtype) :let [output-type =type] _ (&type/check exo-type output-type) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" "getstatic"]) (&/|list) (&/|list class field output-type))))))) (defn- analyse-jvm-getfield [analyse exo-type class field ?values] @@ -671,8 +671,8 @@ =type (analyse-field-access-helper (&&/expr-type* =object) gvars gtype) :let [output-type =type] _ (&type/check exo-type output-type) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" "getfield"]) (&/|list =object) (&/|list class field output-type))))))) (defn- analyse-jvm-putstatic [analyse exo-type class field ?values] @@ -685,8 +685,8 @@ =value (&&/analyse-1 analyse =type value) :let [output-type &type/Any] _ (&type/check exo-type output-type) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" "putstatic"]) (&/|list =value) (&/|list class field gclass))))))) (defn- analyse-jvm-putfield [analyse exo-type class field ?values] @@ -702,8 +702,8 @@ =value (&&/analyse-1 analyse =type value) :let [output-type &type/Any] _ (&type/check exo-type output-type) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" "putfield"]) (&/|list =object =value) (&/|list class field gclass =type))))))) (defn- analyse-method-call-helper [analyse exo-type gret gtype-env gtype-vars gtype-args args] @@ -762,8 +762,8 @@ =object (&&/analyse-1+ analyse object) gtype-env (up-cast class parent-gvars class-loader !class! (&&/expr-type* =object)) [output-type =args] (analyse-method-call-helper analyse exo-type gret gtype-env gvars gargs args) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" <tag>]) (&/$Cons =object =args) (&/|list class method classes output-type gret))))))) analyse-jvm-invokevirtual "invokevirtual" false @@ -778,8 +778,8 @@ [gret exceptions parent-gvars gvars gargs] (&host/lookup-static-method class-loader !class! method classes) :let [gtype-env (&/|table)] [output-type =args] (analyse-method-call-helper analyse exo-type gret gtype-env gvars gargs args) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" "invokestatic"]) =args (&/|list class method classes output-type gret))))))) (defn- analyse-jvm-new-helper [analyse gtype gtype-env gtype-vars gtype-args args] @@ -808,8 +808,8 @@ [exceptions gvars gargs] (&host/lookup-constructor class-loader !class! classes) [output-type =args] (analyse-jvm-new-helper analyse class (&/|table) gvars gargs args) _ (&type/check exo-type output-type) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor + _location &/location] + (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["jvm" "new"]) =args (&/|list class classes))))))) (defn- analyse-jvm-instanceof [analyse exo-type class ?values] @@ -818,8 +818,8 @@ _ (ensure-object (&&/expr-type* =object)) :let [output-type &type/Bit] _ (&type/check exo-type output-type) - _cursor &/cursor] - (return (&/|list (&&/|meta output-type _cursor + _location &/location] + (return (&/|list (&&/|meta output-type _location (&&/$proc (&/T ["jvm" "instanceof"]) (&/|list =object) (&/|list class))))))) (defn- analyse-jvm-object-class [analyse exo-type ?values] @@ -831,16 +831,16 @@ (&/fail-with-loc (str "[Analyser Error] Unknown class: " _class-name)))) :let [output-type (&/$Primitive "java.lang.Class" (&/|list (&/$Primitive _class-name (&/|list))))] _ (&type/check exo-type output-type) - _cursor &/cursor] - (return (&/|list (&&/|meta output-type _cursor + _location &/location] + (return (&/|list (&&/|meta output-type _location (&&/$proc (&/T ["jvm" "object class"]) (&/|list) (&/|list _class-name output-type))))))) (defn- analyse-jvm-interface [analyse compile-interface interface-decl supers =anns =methods] (|do [module &/get-module-name _ (compile-interface interface-decl supers =anns =methods) :let [_ (println 'INTERFACE (str module "." (&/|first interface-decl)))] - _cursor &/cursor] - (return (&/|list (&&/|meta &type/Any _cursor + _location &/location] + (return (&/|list (&&/|meta &type/Any _location (&&/$tuple (&/|list))))))) (defn- analyse-jvm-class [analyse compile-class class-decl super-class interfaces =inheritance-modifier =anns ?fields methods] @@ -858,8 +858,8 @@ _ (compile-class class-decl super-class interfaces =inheritance-modifier =anns =fields =methods &/$Nil &/$None) _ &/pop-dummy-name :let [_ (println 'CLASS full-name)] - _cursor &/cursor] - (return (&/|list (&&/|meta &type/Any _cursor + _location &/location] + (return (&/|list (&&/|meta &type/Any _location (&&/$tuple (&/|list)))))))) (defn- captured-source [env-entry] @@ -916,9 +916,9 @@ (&/enumerate =captured))] (compile-class class-decl super-class interfaces &/$DefaultIM &/$Nil =fields =methods =captured (&/$Some =ctor-args))) _ &/pop-dummy-name - _cursor &/cursor] + _location &/location] (let [sources (&/|map captured-source =captured)] - (return (&/|list (&&/|meta anon-class-type _cursor + (return (&/|list (&&/|meta anon-class-type _location (&&/$proc (&/T ["jvm" "new"]) sources (&/|list anon-class (&/|repeat (&/|length sources) captured-slot-class))))))) )))) @@ -1031,19 +1031,19 @@ ;; else (->> (&/fail-with-loc (str "[Analyser Error] Unknown host procedure: " ["jvm" proc])) (if-let [[_ _def-code] (re-find #"^jvm interface:(.*)$" proc)] - (|do [[_module _line _column] &/cursor] + (|do [[_module _line _column] &/location] (&reader/with-source (str "interface@" "(" _module "," _line "," _column ")") _def-code (|do [[=gclass-decl =supers =anns =methods] &&a-parser/parse-interface-def] (analyse-jvm-interface analyse compile-interface =gclass-decl =supers =anns =methods))))) (if-let [[_ _def-code] (re-find #"^jvm class:(.*)$" proc)] - (|do [[_module _line _column] &/cursor] + (|do [[_module _line _column] &/location] (&reader/with-source (str "class@" "(" _module "," _line "," _column ")") _def-code (|do [[=gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods] &&a-parser/parse-class-def] (analyse-jvm-class analyse compile-class =gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods))))) (if-let [[_ _def-code] (re-find #"^jvm anon-class:(.*)$" proc)] - (|do [[_module _line _column] &/cursor] + (|do [[_module _line _column] &/location] (&reader/with-source (str "anon-class@" "(" _module "," _line "," _column ")") _def-code (|do [[=super-class =interfaces =ctor-args =methods] &&a-parser/parse-anon-class-def] (analyse-jvm-anon-class analyse compile-class exo-type =super-class =interfaces =ctor-args =methods))))) diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj index 9a0bc1b5a..6ee111724 100644 --- a/luxc/src/lux/base.clj +++ b/luxc/src/lux/base.clj @@ -147,7 +147,7 @@ (deftuple ["info" "source" - "cursor" + "location" "current-module" "modules" "scopes" @@ -221,7 +221,7 @@ (def ^:const ^String version "0.6.0") ;; Constructors -(def empty-cursor (T ["" -1 -1])) +(def empty-location (T ["" -1 -1])) (defn get$ [slot ^objects record] (aget record slot)) @@ -590,7 +590,7 @@ (defn fail-with-loc [msg] (fn [state] - (fail* (add-loc (get$ $cursor state) msg)))) + (fail* (add-loc (get$ $location state) msg)))) (defn assert! [test message] (if test @@ -820,7 +820,7 @@ (default-info name mode) ;; "lux;source" $Nil - ;; "lux;cursor" + ;; "lux;location" (T ["" -1 -1]) ;; "current-module" $None @@ -1024,26 +1024,26 @@ _ output)))) -(defn with-cursor - "(All [a] (-> Cursor (Meta a)))" - [^objects cursor body] - (|let [[_file-name _ _] cursor] +(defn with-location + "(All [a] (-> Location (Meta a)))" + [^objects location body] + (|let [[_file-name _ _] location] (if (= "" _file-name) body (fn [state] - (let [output (body (set$ $cursor cursor state))] + (let [output (body (set$ $location location state))] (|case output ($Right ?state ?value) - (return* (set$ $cursor (get$ $cursor state) ?state) + (return* (set$ $location (get$ $location state) ?state) ?value) _ output)))))) (defn with-analysis-meta - "(All [a] (-> Cursor Type (Meta a)))" - [^objects cursor type body] - (|let [[_file-name _ _] cursor] + "(All [a] (-> Location Type (Meta a)))" + [^objects location type body] + (|let [[_file-name _ _] location] (if (= "" _file-name) (fn [state] (let [output (body (->> state @@ -1058,12 +1058,12 @@ output))) (fn [state] (let [output (body (->> state - (set$ $cursor cursor) + (set$ $location location) (set$ $expected ($Some type))))] (|case output ($Right ?state ?value) (return* (->> ?state - (set$ $cursor (get$ $cursor state)) + (set$ $location (get$ $location state)) (set$ $expected (get$ $expected state))) ?value) @@ -1081,10 +1081,10 @@ ((fail-with-loc "[Error] All directives must be top-level forms.") state)))) -(def cursor - ;; (Meta Cursor) +(def location + ;; (Meta Location) (fn [state] - (return* state (get$ $cursor state)))) + (return* state (get$ $location state)))) (def rev-bits 64) @@ -1118,14 +1118,14 @@ output))) rev-digits-lt (fn rev-digits-lt ([subject param index] - (and (< index rev-bits) - (or (< (get subject index) - (get param index)) - (and (= (get subject index) - (get param index)) - (rev-digits-lt subject param (inc index)))))) + (and (< index rev-bits) + (or (< (get subject index) + (get param index)) + (and (= (get subject index) + (get param index)) + (rev-digits-lt subject param (inc index)))))) ([subject param] - (rev-digits-lt subject param 0))) + (rev-digits-lt subject param 0))) rev-digits-sub-once (fn [subject param-digit index] (if (>= (get subject index) param-digit) diff --git a/luxc/src/lux/compiler/cache/ann.clj b/luxc/src/lux/compiler/cache/ann.clj index a7def470a..4c08af276 100644 --- a/luxc/src/lux/compiler/cache/ann.clj +++ b/luxc/src/lux/compiler/cache/ann.clj @@ -67,14 +67,14 @@ (declare deserialize) -(def dummy-cursor +(def dummy-location (&/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)] - [(&/T [dummy-cursor (<ctor> (<parser> value*))]) input*]))) + [(&/T [dummy-location (<ctor> (<parser> value*))]) input*]))) ^:private deserialize-bit "B" &/$Bit Boolean/parseBoolean ^:private deserialize-nat "N" &/$Nat Long/parseLong @@ -89,7 +89,7 @@ (when (.startsWith input <marker>) (let [[^String ident* ^String input*] (.split (.substring input 1) stop 2) [_module _name] (.split ident* "\\." 2)] - [(&/T [dummy-cursor (<tag> (&/T [_module _name]))]) input*]))) + [(&/T [dummy-location (<tag> (&/T [_module _name]))]) input*]))) ^:private deserialize-identifier "@" &/$Identifier ^:private deserialize-tag "#" &/$Tag) @@ -114,7 +114,7 @@ (when (.startsWith input <signal>) (when-let [[elems ^String input*] (deserialize-seq <deserializer> (.substring input 1))] - [(&/T [dummy-cursor (<type> elems)]) input*]))) + [(&/T [dummy-location (<type> elems)]) input*]))) ^:private deserialize-form "(" &/$Form deserialize ^:private deserialize-tuple "[" &/$Tuple deserialize diff --git a/luxc/src/lux/compiler/jvm.clj b/luxc/src/lux/compiler/jvm.clj index 5ed579116..e1a51b73a 100644 --- a/luxc/src/lux/compiler/jvm.clj +++ b/luxc/src/lux/compiler/jvm.clj @@ -126,7 +126,7 @@ (&/with-eval (|do [module &/get-module-name id &/gen-id - [file-name _ _] &/cursor + [file-name _ _] &/location :let [class-name (str (&host/->module-class module) "/" id) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) diff --git a/luxc/src/lux/compiler/jvm/function.clj b/luxc/src/lux/compiler/jvm/function.clj index 551f0851c..eb779a7b6 100644 --- a/luxc/src/lux/compiler/jvm/function.clj +++ b/luxc/src/lux/compiler/jvm/function.clj @@ -234,7 +234,7 @@ (let [function-flags (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) datum-flags (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL)] (defn compile-function [compile ?prev-writer arity ?scope ?env ?body] - (|do [[file-name _ _] &/cursor + (|do [[file-name _ _] &/location :let [??scope (&/|reverse ?scope) name (&host/location (&/|tail ??scope)) class-name (str (&host/->module-class (&/|head ??scope)) "/" name) diff --git a/luxc/src/lux/compiler/jvm/lux.clj b/luxc/src/lux/compiler/jvm/lux.clj index bfa8b2bdb..043fc2273 100644 --- a/luxc/src/lux/compiler/jvm/lux.clj +++ b/luxc/src/lux/compiler/jvm/lux.clj @@ -272,7 +272,7 @@ (|let [[_ (&o/$function _ _arity _scope _captured ?body+)] (&o/shift-function-body (&/|tail __scope) __scope false (de-ann ?body))] - (|do [[file-name _ _] &/cursor + (|do [[file-name _ _] &/location :let [datum-sig "Ljava/lang/Object;" def-name (&host/def-name ?name) current-class (str (&host/->module-class module-name) "/" def-name) @@ -300,7 +300,7 @@ (return def-value))) _ - (|do [[file-name _ _] &/cursor + (|do [[file-name _ _] &/location :let [datum-sig "Ljava/lang/Object;" def-name (&host/def-name ?name) current-class (str (&host/->module-class module-name) "/" def-name) diff --git a/luxc/src/lux/compiler/jvm/proc/host.clj b/luxc/src/lux/compiler/jvm/proc/host.clj index 293563d78..ec934ae7b 100644 --- a/luxc/src/lux/compiler/jvm/proc/host.clj +++ b/luxc/src/lux/compiler/jvm/proc/host.clj @@ -90,10 +90,10 @@ ;; [Resources] (defn ^:private compile-annotation [^ClassWriter writer ann] (doto ^AnnotationVisitor (.visitAnnotation writer (&host-generics/->type-signature (:name ann)) true) - (-> (.visit param-name param-value) - (->> (|let [[param-name param-value] param]) - (doseq [param (&/->seq (:params ann))]))) - (.visitEnd)) + (-> (.visit param-name param-value) + (->> (|let [[param-name param-value] param]) + (doseq [param (&/->seq (:params ann))]))) + (.visitEnd)) nil) (defn ^:private compile-field [^ClassWriter writer field] @@ -457,7 +457,7 @@ (declare compile-jvm-putstatic) (defn compile-jvm-class [compile class-decl ?super-class ?interfaces ?inheritance-modifier ?anns ?fields ?methods env ??ctor-args] (|do [module &/get-module-name - [file-name line column] &/cursor + [file-name line column] &/location :let [[?name ?params] class-decl class-signature (&host-generics/gclass-decl->signature class-decl (&/$Cons ?super-class ?interfaces)) full-name (str module "/" ?name) @@ -495,7 +495,7 @@ (defn compile-jvm-interface [interface-decl ?supers ?anns ?methods] (|do [:let [[interface-name interface-vars] interface-decl] module &/get-module-name - [file-name _ _] &/cursor + [file-name _ _] &/location :let [interface-signature (&host-generics/gclass-decl->signature interface-decl ?supers) =interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT Opcodes/ACC_INTERFACE) diff --git a/luxc/src/lux/repl.clj b/luxc/src/lux/repl.clj index 6f167d8b1..d980ac9ec 100644 --- a/luxc/src/lux/repl.clj +++ b/luxc/src/lux/repl.clj @@ -16,7 +16,7 @@ ;; [Utils] (def ^:private repl-module "REPL") -(defn ^:private repl-cursor [repl-line] +(defn ^:private repl-location [repl-line] (&/T [repl-module repl-line 0])) (defn ^:private init [source-dirs] @@ -26,7 +26,7 @@ _ (&module/create-module repl-module 0) _ (fn [?state] (return* (&/set$ &/$source - (&/|list (&/T [(repl-cursor -1) "(;module: lux)"])) + (&/|list (&/T [(repl-location -1) "(;module: lux)"])) ?state) nil)) analysed-tokens (&analyser/repl-analyse &optimizer/optimize &compiler/eval! (partial &compiler/compile-module source-dirs) &compiler/all-compilers) @@ -58,14 +58,14 @@ line (.readLine input)] (if (= "exit" line) (println "Till next time...") - (let [line* (&/|list (&/T [(repl-cursor repl-line) line])) + (let [line* (&/|list (&/T [(repl-location repl-line) line])) state* (&/update$ &/$source (fn [_source] (&/|++ _source line*)) state)] (|case ((|do [analysed-tokens (&analyser/repl-analyse &optimizer/optimize &compiler/eval! (partial &compiler/compile-module source-dirs) &compiler/all-compilers) eval-values (->> analysed-tokens (&/|map &optimizer/optimize) (&/map% &compiler/eval!)) :let [outputs (map (fn [analysis value] - (|let [[[_type _cursor] _term] analysis] + (|let [[[_type _location] _term] analysis] [_type value])) (&/->seq analysed-tokens) (&/->seq eval-values))]] diff --git a/luxc/src/lux/type.clj b/luxc/src/lux/type.clj index ae80d1142..924489a53 100644 --- a/luxc/src/lux/type.clj +++ b/luxc/src/lux/type.clj @@ -120,8 +120,8 @@ (&/$Product Ident Type))))))))))) ))))) -(def Cursor - (&/$Named (&/T ["lux" "Cursor"]) +(def Location + (&/$Named (&/T ["lux" "Location"]) (&/$Product Text (&/$Product Nat Nat)))) (def Meta @@ -165,7 +165,7 @@ (def Code (&/$Named (&/T ["lux" "Code"]) - (let [w (&/$Apply Cursor Meta)] + (let [w (&/$Apply Location Meta)] (&/$Apply (&/$Apply w Code*) w)))) (def Macro*) @@ -221,7 +221,7 @@ (&/$None) (return* (&/update$ &/$type-context (fn [ts] (&/update$ &/$var-bindings #(&/|put id (&/$Some type) %) - ts)) + ts)) state) nil)) ((&/fail-with-loc (str "[Type Error] Unknown type-var: " id " | " (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) &/|length))) @@ -231,7 +231,7 @@ (fn [state] (if-let [tvar (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) (&/|get id))] (return* (&/update$ &/$type-context (fn [ts] (&/update$ &/$var-bindings #(&/|put id (&/$Some type) %) - ts)) + ts)) state) nil) ((&/fail-with-loc (str "[Type Error] Unknown type-var: " id " | " (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) &/|length))) @@ -241,7 +241,7 @@ (fn [state] (if-let [tvar (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) (&/|get id))] (return* (&/update$ &/$type-context (fn [ts] (&/update$ &/$var-bindings #(&/|put id &/$None %) - ts)) + ts)) state) nil) ((&/fail-with-loc (str "[Type Error] Unknown type-var: " id " | " (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) &/|length))) @@ -288,23 +288,23 @@ (if (= ?tid ?id) (|do [? (bound? ?id)] (if ? - (deref ?id) + (deref ?id) (return type))) (|do [? (bound? ?id)] (if ? - (|do [=type (deref ?id) - ==type (clean* ?tid =type)] - (|case ==type - (&/$Var =id) - (if (= ?tid =id) - (|do [_ (unset-var ?id)] - (return type)) + (|do [=type (deref ?id) + ==type (clean* ?tid =type)] + (|case ==type + (&/$Var =id) + (if (= ?tid =id) + (|do [_ (unset-var ?id)] + (return type)) + (|do [_ (reset-var ?id ==type)] + (return type))) + + _ (|do [_ (reset-var ?id ==type)] - (return type))) - - _ - (|do [_ (reset-var ?id ==type)] - (return ==type)))) + (return ==type)))) (return type))) ) @@ -365,14 +365,14 @@ (defn ^:private unravel-app ([fun-type tail] - (|case fun-type - (&/$Apply ?arg ?func) - (unravel-app ?func (&/$Cons ?arg tail)) + (|case fun-type + (&/$Apply ?arg ?func) + (unravel-app ?func (&/$Cons ?arg tail)) - _ - (&/T [fun-type tail]))) + _ + (&/T [fun-type tail]))) ([fun-type] - (unravel-app fun-type &/$Nil))) + (unravel-app fun-type &/$Nil))) (do-template [<tag> <flatten> <at> <desc>] (do (defn <flatten> @@ -757,7 +757,7 @@ (|case (fp-get fp-pair fixpoints) (&/$Some ?) (if ? - (return fixpoints) + (return fixpoints) (check-error "" expected actual)) (&/$None) @@ -800,15 +800,15 @@ [(&/$Primitive e!data) (&/$Primitive a!data)] (|do [? &/jvm?] (if ? - (|do [class-loader &/loader] - (&&host/check-host-types (partial check* fixpoints true) - check-error - fixpoints - existential - class-loader - invariant?? - e!data - a!data)) + (|do [class-loader &/loader] + (&&host/check-host-types (partial check* fixpoints true) + check-error + fixpoints + existential + class-loader + invariant?? + e!data + a!data)) (|let [[e!name e!params] e!data [a!name a!params] a!data] (if (and (= e!name a!name) @@ -897,7 +897,7 @@ (&/$Var id) (|do [? (bound? id)] (if ? - (deref id) + (deref id) (return type))) _ diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 2409d3f39..fa33ac0b4 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1,21 +1,21 @@ -("lux def" dummy-cursor +("lux def" dummy-location ["" 0 0] [["" 0 0] (9 #1 (0 #0))] #1) ("lux def" double-quote ("lux i64 char" +34) - [dummy-cursor (9 #1 (0 #0))] + [dummy-location (9 #1 (0 #0))] #0) ("lux def" new-line ("lux i64 char" +10) - [dummy-cursor (9 #1 (0 #0))] + [dummy-location (9 #1 (0 #0))] #0) ("lux def" __paragraph ("lux text concat" new-line new-line) - [dummy-cursor (9 #1 (0 #0))] + [dummy-location (9 #1 (0 #0))] #0) ## (type: Any @@ -24,11 +24,11 @@ ("lux check type" (9 #1 ["lux" "Any"] (8 #0 (0 #0) (4 #0 1)))) - [dummy-cursor - (9 #1 (0 #1 [[dummy-cursor (7 #0 ["lux" "doc"])] - [dummy-cursor (5 #0 ("lux text concat" - ("lux text concat" "The type of things whose type is irrelevant." __paragraph) - "It can be used to write functions or data-structures that can take, or return, anything."))]] + [dummy-location + (9 #1 (0 #1 [[dummy-location (7 #0 ["lux" "doc"])] + [dummy-location (5 #0 ("lux text concat" + ("lux text concat" "The type of things whose type is irrelevant." __paragraph) + "It can be used to write functions or data-structures that can take, or return, anything."))]] (0 #0)))] #1) @@ -38,11 +38,11 @@ ("lux check type" (9 #1 ["lux" "Nothing"] (7 #0 (0 #0) (4 #0 1)))) - [dummy-cursor - (9 #1 (0 #1 [[dummy-cursor (7 #0 ["lux" "doc"])] - [dummy-cursor (5 #0 ("lux text concat" - ("lux text concat" "The type of things whose type is undefined." __paragraph) - "Useful for expressions that cause errors or other 'extraordinary' conditions."))]] + [dummy-location + (9 #1 (0 #1 [[dummy-location (7 #0 ["lux" "doc"])] + [dummy-location (5 #0 ("lux text concat" + ("lux text concat" "The type of things whose type is undefined." __paragraph) + "Useful for expressions that cause errors or other 'extraordinary' conditions."))]] (0 #0)))] #1) @@ -57,11 +57,11 @@ ## "lux.Cons" (2 #0 (4 #0 1) (9 #0 (4 #0 1) (4 #0 0)))))) - [dummy-cursor - (9 #1 (0 #1 [[dummy-cursor (7 #0 ["lux" "type-args"])] - [dummy-cursor (9 #0 (0 #1 [dummy-cursor (5 #0 "a")] (0 #0)))]] - (0 #1 [[dummy-cursor (7 #0 ["lux" "doc"])] - [dummy-cursor (5 #0 "A potentially empty list of values.")]] + [dummy-location + (9 #1 (0 #1 [[dummy-location (7 #0 ["lux" "type-args"])] + [dummy-location (9 #0 (0 #1 [dummy-location (5 #0 "a")] (0 #0)))]] + (0 #1 [[dummy-location (7 #0 ["lux" "doc"])] + [dummy-location (5 #0 "A potentially empty list of values.")]] (0 #0))))] ["Nil" "Cons"] #1) @@ -70,9 +70,9 @@ ("lux check type" (9 #1 ["lux" "Bit"] (0 #0 "#Bit" #Nil))) - [dummy-cursor - (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] - [dummy-cursor (5 #0 "Your standard, run-of-the-mill boolean values (as bits).")]] + [dummy-location + (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] + [dummy-location (5 #0 "Your standard, run-of-the-mill boolean values (as bits).")]] #Nil))] #1) @@ -81,9 +81,9 @@ (9 #1 ["lux" "I64"] (7 #0 (0 #0) (0 #0 "#I64" (#Cons (4 #0 1) #Nil))))) - [dummy-cursor - (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] - [dummy-cursor (5 #0 "64-bit integers without any semantics.")]] + [dummy-location + (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] + [dummy-location (5 #0 "64-bit integers without any semantics.")]] #Nil))] #1) @@ -91,11 +91,11 @@ ("lux check type" (9 #1 ["lux" "Nat"] (0 #0 "#I64" (#Cons (0 #0 "#Nat" #Nil) #Nil)))) - [dummy-cursor - (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] - [dummy-cursor (5 #0 ("lux text concat" - ("lux text concat" "Natural numbers (unsigned integers)." __paragraph) - "They start at zero (0) and extend in the positive direction."))]] + [dummy-location + (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] + [dummy-location (5 #0 ("lux text concat" + ("lux text concat" "Natural numbers (unsigned integers)." __paragraph) + "They start at zero (0) and extend in the positive direction."))]] #Nil))] #1) @@ -103,9 +103,9 @@ ("lux check type" (9 #1 ["lux" "Int"] (0 #0 "#I64" (#Cons (0 #0 "#Int" #Nil) #Nil)))) - [dummy-cursor - (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] - [dummy-cursor (5 #0 "Your standard, run-of-the-mill integer numbers.")]] + [dummy-location + (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] + [dummy-location (5 #0 "Your standard, run-of-the-mill integer numbers.")]] #Nil))] #1) @@ -113,11 +113,11 @@ ("lux check type" (9 #1 ["lux" "Rev"] (0 #0 "#I64" (#Cons (0 #0 "#Rev" #Nil) #Nil)))) - [dummy-cursor - (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] - [dummy-cursor (5 #0 ("lux text concat" - ("lux text concat" "Fractional numbers that live in the interval [0,1)." __paragraph) - "Useful for probability, and other domains that work within that interval."))]] + [dummy-location + (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] + [dummy-location (5 #0 ("lux text concat" + ("lux text concat" "Fractional numbers that live in the interval [0,1)." __paragraph) + "Useful for probability, and other domains that work within that interval."))]] #Nil))] #1) @@ -125,9 +125,9 @@ ("lux check type" (9 #1 ["lux" "Frac"] (0 #0 "#Frac" #Nil))) - [dummy-cursor - (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] - [dummy-cursor (5 #0 "Your standard, run-of-the-mill floating-point (fractional) numbers.")]] + [dummy-location + (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] + [dummy-location (5 #0 "Your standard, run-of-the-mill floating-point (fractional) numbers.")]] #Nil))] #1) @@ -135,9 +135,9 @@ ("lux check type" (9 #1 ["lux" "Text"] (0 #0 "#Text" #Nil))) - [dummy-cursor - (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] - [dummy-cursor (5 #0 "Your standard, run-of-the-mill string values.")]] + [dummy-location + (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] + [dummy-location (5 #0 "Your standard, run-of-the-mill string values.")]] #Nil))] #1) @@ -145,9 +145,9 @@ ("lux check type" (9 #1 ["lux" "Name"] (2 #0 Text Text))) - [dummy-cursor - (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] - [dummy-cursor (5 #0 "A name. It is used as part of Lux syntax to represent identifiers and tags.")]] + [dummy-location + (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] + [dummy-location (5 #0 "A name. It is used as part of Lux syntax to represent identifiers and tags.")]] #Nil))] #1) @@ -161,11 +161,11 @@ Any ## "lux.Some" (4 #0 1)))) - [dummy-cursor - (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "type-args"])] - [dummy-cursor (9 #0 (#Cons [dummy-cursor (5 #0 "a")] #Nil))]] - (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] - [dummy-cursor (5 #0 "A potentially missing value.")]] + [dummy-location + (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "type-args"])] + [dummy-location (9 #0 (#Cons [dummy-location (5 #0 "a")] #Nil))]] + (#Cons [[dummy-location (7 #0 ["lux" "doc"])] + [dummy-location (5 #0 "A potentially missing value.")]] #Nil)))] ["None" "Some"] #1) @@ -215,25 +215,25 @@ ("lux check type" (2 #0 Type Type)))} ("lux check type" (9 #0 Type List)))} ("lux check type" (9 #0 (4 #0 1) (4 #0 0))))) - [dummy-cursor - (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] - [dummy-cursor (5 #0 "This type represents the data-structures that are used to specify types themselves.")]] - (#Cons [[dummy-cursor (7 #0 ["lux" "type-rec?"])] - [dummy-cursor (0 #0 #1)]] + [dummy-location + (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] + [dummy-location (5 #0 "This type represents the data-structures that are used to specify types themselves.")]] + (#Cons [[dummy-location (7 #0 ["lux" "type-rec?"])] + [dummy-location (0 #0 #1)]] #Nil)))] ["Primitive" "Sum" "Product" "Function" "Parameter" "Var" "Ex" "UnivQ" "ExQ" "Apply" "Named"] #1) -## (type: Cursor +## (type: Location ## {#module Text ## #line Nat ## #column Nat}) -("lux def type tagged" Cursor - (#Named ["lux" "Cursor"] +("lux def type tagged" Location + (#Named ["lux" "Location"] (#Product Text (#Product Nat Nat))) - [dummy-cursor - (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] - [dummy-cursor (5 #0 "Cursors are for specifying the location of Code nodes in Lux files during compilation.")]] + [dummy-location + (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] + [dummy-location (5 #0 "Locations are for specifying the location of Code nodes in Lux files during compilation.")]] #Nil))] ["module" "line" "column"] #1) @@ -247,11 +247,11 @@ (#UnivQ #Nil (#Product (#Parameter 3) (#Parameter 1))))) - [dummy-cursor - (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] - [dummy-cursor (5 #0 "The type of things that can be annotated with meta-data of arbitrary types.")]] - (#Cons [[dummy-cursor (7 #0 ["lux" "type-args"])] - [dummy-cursor (9 #0 (#Cons [dummy-cursor (5 #0 "m")] (#Cons [dummy-cursor (5 #0 "v")] #Nil)))]] + [dummy-location + (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] + [dummy-location (5 #0 "The type of things that can be annotated with meta-data of arbitrary types.")]] + (#Cons [[dummy-location (7 #0 ["lux" "type-args"])] + [dummy-location (9 #0 (#Cons [dummy-location (5 #0 "m")] (#Cons [dummy-location (5 #0 "v")] #Nil)))]] #Nil)))] ["meta" "datum"] #1) @@ -301,111 +301,111 @@ ("lux check type" (#Apply (#Apply (#Parameter 1) (#Parameter 0)) (#Parameter 1))))) - [dummy-cursor - (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "type-args"])] - [dummy-cursor (9 #0 (#Cons [dummy-cursor (5 #0 "w")] #Nil))]] + [dummy-location + (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "type-args"])] + [dummy-location (9 #0 (#Cons [dummy-location (5 #0 "w")] #Nil))]] #Nil))] ["Bit" "Nat" "Int" "Rev" "Frac" "Text" "Identifier" "Tag" "Form" "Tuple" "Record"] #1) ## (type: Code -## (Ann Cursor (Code' (Ann Cursor)))) +## (Ann Location (Code' (Ann Location)))) ("lux def" Code (#Named ["lux" "Code"] ({w (#Apply (#Apply w Code') w)} - ("lux check type" (#Apply Cursor Ann)))) - [dummy-cursor - (#Record (#Cons [[dummy-cursor (#Tag ["lux" "doc"])] - [dummy-cursor (#Text "The type of Code nodes for Lux syntax.")]] + ("lux check type" (#Apply Location Ann)))) + [dummy-location + (#Record (#Cons [[dummy-location (#Tag ["lux" "doc"])] + [dummy-location (#Text "The type of Code nodes for Lux syntax.")]] #Nil))] #1) ("lux def" _ann - ("lux check" (#Function (#Apply (#Apply Cursor Ann) + ("lux check" (#Function (#Apply (#Apply Location Ann) Code') Code) ([_ data] - [dummy-cursor data])) - [dummy-cursor (#Record #Nil)] + [dummy-location data])) + [dummy-location (#Record #Nil)] #0) ("lux def" bit$ ("lux check" (#Function Bit Code) ([_ value] (_ann (#Bit value)))) - [dummy-cursor (#Record #Nil)] + [dummy-location (#Record #Nil)] #0) ("lux def" nat$ ("lux check" (#Function Nat Code) ([_ value] (_ann (#Nat value)))) - [dummy-cursor (#Record #Nil)] + [dummy-location (#Record #Nil)] #0) ("lux def" int$ ("lux check" (#Function Int Code) ([_ value] (_ann (#Int value)))) - [dummy-cursor (#Record #Nil)] + [dummy-location (#Record #Nil)] #0) ("lux def" rev$ ("lux check" (#Function Rev Code) ([_ value] (_ann (#Rev value)))) - [dummy-cursor (#Record #Nil)] + [dummy-location (#Record #Nil)] #0) ("lux def" frac$ ("lux check" (#Function Frac Code) ([_ value] (_ann (#Frac value)))) - [dummy-cursor (#Record #Nil)] + [dummy-location (#Record #Nil)] #0) ("lux def" text$ ("lux check" (#Function Text Code) ([_ text] (_ann (#Text text)))) - [dummy-cursor (#Record #Nil)] + [dummy-location (#Record #Nil)] #0) ("lux def" identifier$ ("lux check" (#Function Name Code) ([_ name] (_ann (#Identifier name)))) - [dummy-cursor (#Record #Nil)] + [dummy-location (#Record #Nil)] #0) ("lux def" local-identifier$ ("lux check" (#Function Text Code) ([_ name] (_ann (#Identifier ["" name])))) - [dummy-cursor (#Record #Nil)] + [dummy-location (#Record #Nil)] #0) ("lux def" tag$ ("lux check" (#Function Name Code) ([_ name] (_ann (#Tag name)))) - [dummy-cursor (#Record #Nil)] + [dummy-location (#Record #Nil)] #0) ("lux def" local-tag$ ("lux check" (#Function Text Code) ([_ name] (_ann (#Tag ["" name])))) - [dummy-cursor (#Record #Nil)] + [dummy-location (#Record #Nil)] #0) ("lux def" form$ ("lux check" (#Function (#Apply Code List) Code) ([_ tokens] (_ann (#Form tokens)))) - [dummy-cursor (#Record #Nil)] + [dummy-location (#Record #Nil)] #0) ("lux def" tuple$ ("lux check" (#Function (#Apply Code List) Code) ([_ tokens] (_ann (#Tuple tokens)))) - [dummy-cursor (#Record #Nil)] + [dummy-location (#Record #Nil)] #0) ("lux def" record$ ("lux check" (#Function (#Apply (#Product Code Code) List) Code) ([_ tokens] (_ann (#Record tokens)))) - [dummy-cursor (#Record #Nil)] + [dummy-location (#Record #Nil)] #0) ## (type: Definition @@ -518,11 +518,11 @@ #1) ## (type: Source -## [Cursor Nat Text]) +## [Location Nat Text]) ("lux def" Source ("lux check type" (#Named ["lux" "Source"] - (#Product Cursor (#Product Nat Text)))) + (#Product Location (#Product Nat Text)))) (record$ #Nil) #1) @@ -644,7 +644,7 @@ ## (type: Lux ## {#info Info ## #source Source -## #cursor Cursor +## #location Location ## #current-module (Maybe Text) ## #modules (List [Text Module]) ## #scopes (List Scope) @@ -660,8 +660,8 @@ Info (#Product ## "lux.source" Source - (#Product ## "lux.cursor" - Cursor + (#Product ## "lux.location" + Location (#Product ## "lux.current-module" (#Apply Text Maybe) (#Product ## "lux.modules" @@ -687,7 +687,7 @@ ("lux text concat" "It is provided to macros during their invocation, so they can access compiler data." __paragraph) "Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")))] #Nil)) - ["info" "source" "cursor" "current-module" "modules" "scopes" "type-context" "expected" "seed" "scope-type-vars" "extensions" "host"] + ["info" "source" "location" "current-module" "modules" "scopes" "type-context" "expected" "seed" "scope-type-vars" "extensions" "host"] #1) ## (type: (Meta a) @@ -805,7 +805,7 @@ (record$ #.Nil) #0) -("lux def" cursor-code +("lux def" location-code ("lux check" Code (tuple$ (#Cons (text$ "") (#Cons (nat$ 0) (#Cons (nat$ 0) #Nil))))) (record$ #Nil) @@ -815,7 +815,7 @@ ("lux check" (#Function Name (#Function Code Code)) ([_ tag] ([_ value] - (tuple$ (#Cons cursor-code + (tuple$ (#Cons location-code (#Cons (form$ (#Cons (tag$ tag) (#Cons value #Nil))) #Nil)))))) (record$ #Nil) @@ -1723,7 +1723,7 @@ (let' [[module name] full-name {#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor #extensions extensions + #seed seed #expected expected #location location #extensions extensions #scope-type-vars scope-type-vars} state] ({(#Some {#module-hash _ #module-aliases _ #definitions definitions #imports _ #tags tags #types types #module-annotations _ #module-state _}) ({(#Some constant) @@ -1907,7 +1907,7 @@ ($' Meta Text) ({{#info info #source source #current-module current-module #modules modules #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor #extensions extensions + #seed seed #expected expected #location location #extensions extensions #scope-type-vars scope-type-vars} ({(#Some module-name) (#Right [state module-name]) @@ -2331,7 +2331,7 @@ ({{#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host #seed seed #expected expected - #cursor cursor #extensions extensions + #location location #extensions extensions #scope-type-vars scope-type-vars} (#Right state (find-macro' modules current-module module name))} state))))) @@ -2595,12 +2595,12 @@ ({{#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host #seed seed #expected expected - #cursor cursor #extensions extensions + #location location #extensions extensions #scope-type-vars scope-type-vars} (#Right {#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host #seed ("lux i64 +" 1 seed) #expected expected - #cursor cursor #extensions extensions + #location location #extensions extensions #scope-type-vars scope-type-vars} (local-identifier$ ($_ text@compose "__gensym__" prefix (nat@encode seed))))} state)) @@ -2679,7 +2679,7 @@ ?type)] (return (list (` ("lux def" (~ name) (~ body'') - [(~ cursor-code) + [(~ location-code) (#.Record #.Nil)] (~ (bit$ export?))))))) @@ -2983,10 +2983,10 @@ meta _ - (` (#.Cons [[(~ cursor-code) (#.Tag ["lux" "func-args"])] - [(~ cursor-code) (#.Tuple (.list (~+ (list@map (function (_ arg) - (` [(~ cursor-code) (#.Text (~ (text$ (code@encode arg))))])) - args))))]] + (` (#.Cons [[(~ location-code) (#.Tag ["lux" "func-args"])] + [(~ location-code) (#.Tuple (.list (~+ (list@map (function (_ arg) + (` [(~ location-code) (#.Text (~ (text$ (code@encode arg))))])) + args))))]] (~ meta))))) (def:' (with-type-args args) @@ -3067,7 +3067,7 @@ =meta (process-def-meta meta)] (return (list (` ("lux def" (~ name) (~ body) - [(~ cursor-code) + [(~ location-code) (#.Record (~ (with-func-args args =meta)))] (~ (bit$ exported?))))))) @@ -3077,8 +3077,8 @@ (def: (meta-code-add addition meta) (-> [Code Code] Code Code) (case [addition meta] - [[name value] [cursor (#Record pairs)]] - [cursor (#Record (#Cons [name value] pairs))] + [[name value] [location (#Record pairs)]] + [location (#Record (#Cons [name value] pairs))] _ meta)) @@ -3086,7 +3086,7 @@ (def: (meta-code-merge addition base) (-> Code Code Code) (case addition - [cursor (#Record pairs)] + [location (#Record pairs)] (list@fold meta-code-add base pairs) _ @@ -3135,7 +3135,7 @@ =meta (process-def-meta meta)] (return (list (` ("lux def" (~ name) (~ body) - [(~ cursor-code) + [(~ location-code) (#Record (~ =meta))] (~ (bit$ exported?))))))) @@ -3159,11 +3159,11 @@ (let [[exported? tokens'] (export^ tokens) ?parts (: (Maybe [Name (List Code) Code (List Code)]) (case tokens' - (^ (list& [_ (#Form (list& [_ (#Identifier name)] args))] [meta-rec-cursor (#Record meta-rec-parts)] sigs)) - (#Some name args [meta-rec-cursor (#Record meta-rec-parts)] sigs) + (^ (list& [_ (#Form (list& [_ (#Identifier name)] args))] [meta-rec-location (#Record meta-rec-parts)] sigs)) + (#Some name args [meta-rec-location (#Record meta-rec-parts)] sigs) - (^ (list& [_ (#Identifier name)] [meta-rec-cursor (#Record meta-rec-parts)] sigs)) - (#Some name #Nil [meta-rec-cursor (#Record meta-rec-parts)] sigs) + (^ (list& [_ (#Identifier name)] [meta-rec-location (#Record meta-rec-parts)] sigs)) + (#Some name #Nil [meta-rec-location (#Record meta-rec-parts)] sigs) (^ (list& [_ (#Form (list& [_ (#Identifier name)] args))] sigs)) (#Some name args (` {}) sigs) @@ -3260,7 +3260,7 @@ "(default +20 #.None) ## => +20"))} (case tokens (^ (list else maybe)) - (let [g!temp (: Code [dummy-cursor (#Identifier ["" ""])]) + (let [g!temp (: Code [dummy-location (#Identifier ["" ""])]) code (` (case (~ maybe) (#.Some (~ g!temp)) (~ g!temp) @@ -3418,7 +3418,7 @@ (function (_ state) (let [{#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor #extensions extensions + #seed seed #expected expected #location location #extensions extensions #scope-type-vars scope-type-vars} state] (case (get name modules) (#Some module) @@ -3481,7 +3481,7 @@ (function (_ state) (let [{#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor #extensions extensions + #seed seed #expected expected #location location #extensions extensions #scope-type-vars scope-type-vars} state] (case expected (#Some type) @@ -3553,11 +3553,11 @@ (let [[exported? tokens'] (export^ tokens) ?parts (: (Maybe [Code (List Code) Code Code (List Code)]) (case tokens' - (^ (list& [_ (#Form (list& name args))] [meta-rec-cursor (#Record meta-rec-parts)] type definitions)) - (#Some name args type [meta-rec-cursor (#Record meta-rec-parts)] definitions) + (^ (list& [_ (#Form (list& name args))] [meta-rec-location (#Record meta-rec-parts)] type definitions)) + (#Some name args type [meta-rec-location (#Record meta-rec-parts)] definitions) - (^ (list& name [meta-rec-cursor (#Record meta-rec-parts)] type definitions)) - (#Some name #Nil type [meta-rec-cursor (#Record meta-rec-parts)] definitions) + (^ (list& name [meta-rec-location (#Record meta-rec-parts)] type definitions)) + (#Some name #Nil type [meta-rec-location (#Record meta-rec-parts)] definitions) (^ (list& [_ (#Form (list& name args))] type definitions)) (#Some name args type (` {}) definitions) @@ -3599,19 +3599,19 @@ [#0 tokens']) parts (: (Maybe [Text (List Code) (List [Code Code]) (List Code)]) (case tokens' - (^ (list [_ (#Identifier "" name)] [meta-cursor (#Record meta-parts)] [type-cursor (#Record type-parts)])) - (#Some [name #Nil meta-parts (list [type-cursor (#Record type-parts)])]) + (^ (list [_ (#Identifier "" name)] [meta-location (#Record meta-parts)] [type-location (#Record type-parts)])) + (#Some [name #Nil meta-parts (list [type-location (#Record type-parts)])]) - (^ (list& [_ (#Identifier "" name)] [meta-cursor (#Record meta-parts)] type-code1 type-codes)) + (^ (list& [_ (#Identifier "" name)] [meta-location (#Record meta-parts)] type-code1 type-codes)) (#Some [name #Nil meta-parts (#Cons type-code1 type-codes)]) (^ (list& [_ (#Identifier "" name)] type-codes)) (#Some [name #Nil (list) type-codes]) - (^ (list [_ (#Form (#Cons [_ (#Identifier "" name)] args))] [meta-cursor (#Record meta-parts)] [type-cursor (#Record type-parts)])) - (#Some [name args meta-parts (list [type-cursor (#Record type-parts)])]) + (^ (list [_ (#Form (#Cons [_ (#Identifier "" name)] args))] [meta-location (#Record meta-parts)] [type-location (#Record type-parts)])) + (#Some [name args meta-parts (list [type-location (#Record type-parts)])]) - (^ (list& [_ (#Form (#Cons [_ (#Identifier "" name)] args))] [meta-cursor (#Record meta-parts)] type-code1 type-codes)) + (^ (list& [_ (#Form (#Cons [_ (#Identifier "" name)] args))] [meta-location (#Record meta-parts)] type-code1 type-codes)) (#Some [name args meta-parts (#Cons type-code1 type-codes)]) (^ (list& [_ (#Form (#Cons [_ (#Identifier "" name)] args))] type-codes)) @@ -3645,7 +3645,7 @@ meta (if rec? (` (#.Cons (~ (flag-meta "type-rec?")) (~ meta))) meta)] - (` [(~ cursor-code) + (` [(~ location-code) (#.Record (~ meta))]))] (case type' (#Some type'') @@ -3958,7 +3958,7 @@ (let [[current-module modules] (case state {#info info #source source #current-module current-module #modules modules #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor #extensions extensions + #seed seed #expected expected #location location #extensions extensions #scope-type-vars scope-type-vars} [current-module modules])] (case (get module modules) @@ -4026,7 +4026,7 @@ (case state {#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor #extensions extensions + #seed seed #expected expected #location location #extensions extensions #scope-type-vars scope-type-vars} (find (: (-> Scope (Maybe Type)) (function (_ env) @@ -4049,7 +4049,7 @@ (let [[v-prefix v-name] name {#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor #extensions extensions + #seed seed #expected expected #location location #extensions extensions #scope-type-vars scope-type-vars} state] (case (get v-prefix modules) #None @@ -4073,7 +4073,7 @@ (let [[v-prefix v-name] name {#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor #extensions extensions + #seed seed #expected expected #location location #extensions extensions #scope-type-vars scope-type-vars} state] (case (get v-prefix modules) #None @@ -4131,7 +4131,7 @@ (#Right [compiler (#Var type-id)]) (let [{#info _ #source _ #current-module _ #modules _ #scopes _ #type-context type-context #host _ - #seed _ #expected _ #cursor _ #extensions extensions + #seed _ #expected _ #location _ #extensions extensions #scope-type-vars _} compiler {#ex-counter _ #var-counter _ #var-bindings var-bindings} type-context] (case (find-type-var type-id var-bindings) @@ -4367,7 +4367,7 @@ _ (return (list (` ("lux def" (~ (local-identifier$ (de-alias "" short alias))) (~ source+) - [(~ cursor-code) (#.Record #Nil)] + [(~ location-code) (#.Record #Nil)] #0))))))) (macro: #export (open: tokens) @@ -4406,7 +4406,7 @@ (do meta-monad [g!struct (gensym "struct")] (return (list (` ("lux def" (~ g!struct) (~ struct) - [(~ cursor-code) (#.Record #Nil)] + [(~ location-code) (#.Record #Nil)] #0)) (` (..open: (~ (text$ alias)) (~ g!struct))))))) @@ -4584,7 +4584,7 @@ (function (_ [m-name m-alias =refer]) (refer-to-code m-name m-alias =refer))) imports) - =module (` ("lux def module" [(~ cursor-code) + =module (` ("lux def module" [(~ location-code) (#.Record (~ (process-def-meta _meta)))] (~ =imports)))]] (wrap (#Cons =module =refers)))) @@ -4888,8 +4888,8 @@ (#Cons x (repeat ("lux i64 +" -1 n) x)) #Nil)) -(def: (cursor-padding baseline [_ old-line old-column] [_ new-line new-column]) - (-> Nat Cursor Cursor Text) +(def: (location-padding baseline [_ old-line old-column] [_ new-line new-column]) + (-> Nat Location Location Text) (if ("lux i64 =" old-line new-line) (text@join-with "" (repeat (.int ("lux i64 -" old-column new-column)) " ")) (let [extra-lines (text@join-with "" (repeat (.int ("lux i64 -" old-line new-line)) ..new-line)) @@ -4900,26 +4900,26 @@ (-> Text Nat) ("lux text size" x)) -(def: (update-cursor [file line column] code-text) - (-> Cursor Text Cursor) +(def: (update-location [file line column] code-text) + (-> Location Text Location) [file line ("lux i64 +" column (text@size code-text))]) -(def: (delim-update-cursor [file line column]) - (-> Cursor Cursor) +(def: (delim-update-location [file line column]) + (-> Location Location) [file line (inc column)]) (def: rejoin-all-pairs (-> (List [Code Code]) (List Code)) (|>> (list@map rejoin-pair) list@join)) -(def: (doc-example->Text prev-cursor baseline example) - (-> Cursor Nat Code [Cursor Text]) +(def: (doc-example->Text prev-location baseline example) + (-> Location Nat Code [Location Text]) (case example (^template [<tag> <encode>] - [new-cursor (<tag> value)] + [new-location (<tag> value)] (let [as-text (<encode> value)] - [(update-cursor new-cursor as-text) - (text@compose (cursor-padding baseline prev-cursor new-cursor) + [(update-location new-location as-text) + (text@compose (location-padding baseline prev-location new-location) as-text)])) ([#Bit bit@encode] [#Nat nat@encode] @@ -4930,14 +4930,14 @@ [#Tag tag@encode]) (^template [<tag> <open> <close> <prep>] - [group-cursor (<tag> parts)] - (let [[group-cursor' parts-text] (list@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)])) - [(delim-update-cursor group-cursor) ""] - (<prep> parts))] - [(delim-update-cursor group-cursor') - ($_ text@compose (cursor-padding baseline prev-cursor group-cursor) + [group-location (<tag> parts)] + (let [[group-location' parts-text] (list@fold (function (_ part [last-location text-accum]) + (let [[part-location part-text] (doc-example->Text last-location baseline part)] + [part-location (text@compose text-accum part-text)])) + [(delim-update-location group-location) ""] + (<prep> parts))] + [(delim-update-location group-location') + ($_ text@compose (location-padding baseline prev-location group-location) <open> parts-text <close>)])) @@ -4945,12 +4945,12 @@ [#Tuple "[" "]" ..function@identity] [#Record "{" "}" rejoin-all-pairs]) - [new-cursor (#Rev value)] + [new-location (#Rev value)] ("lux io error" "Undefined behavior.") )) (def: (with-baseline baseline [file line column]) - (-> Nat Cursor Cursor) + (-> Nat Location Location) [file line baseline]) (def: (doc-fragment->Text fragment) @@ -4964,8 +4964,8 @@ (#Doc-Example example) (let [baseline (find-baseline-column example) - [cursor _] example - [_ text] (doc-example->Text (with-baseline baseline cursor) baseline example)] + [location _] example + [_ text] (doc-example->Text (with-baseline baseline location) baseline example)] (text@compose text __paragraph)))) (macro: #export (doc tokens) @@ -4980,7 +4980,7 @@ " (if (< +10 count)" ..new-line " (recur (inc count) (f x))" ..new-line " x)))"))} - (return (list (` [(~ cursor-code) + (return (list (` [(~ location-code) (#.Text (~ (|> tokens (list@map (|>> identify-doc-fragment doc-fragment->Text)) (text@join-with "") @@ -5140,14 +5140,14 @@ (#Some (list target))) (^template [<tag>] - [cursor (<tag> elems)] + [location (<tag> elems)] (do maybe-monad [placements (monad@map maybe-monad (place-tokens label tokens) elems)] - (wrap (list [cursor (<tag> (list@join placements))])))) + (wrap (list [location (<tag> (list@join placements))])))) ([#Tuple] [#Form]) - [cursor (#Record pairs)] + [location (#Record pairs)] (do maybe-monad [=pairs (monad@map maybe-monad (: (-> [Code Code] (Maybe [Code Code])) @@ -5162,7 +5162,7 @@ _ #None)))) pairs)] - (wrap (list [cursor (#Record =pairs)]))) + (wrap (list [location (#Record =pairs)]))) )) (macro: #export (with-expansions tokens) @@ -5416,7 +5416,7 @@ (case state {#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor #extensions extensions + #seed seed #expected expected #location location #extensions extensions #scope-type-vars scope-type-vars} (#Right state scope-type-vars) )) @@ -5856,8 +5856,8 @@ _ (fail (..wrong-syntax-error (name-of ..^code))))) -(def: #export (cursor-description [file line column]) - (-> Cursor Text) +(def: #export (location-description [file line column]) + (-> Location Text) (let [separator ", " fields ($_ "lux text concat" (text@encode file) separator diff --git a/stdlib/source/lux/abstract/comonad.lux b/stdlib/source/lux/abstract/comonad.lux index 874b96913..14515da25 100644 --- a/stdlib/source/lux/abstract/comonad.lux +++ b/stdlib/source/lux/abstract/comonad.lux @@ -24,8 +24,6 @@ {#.doc "The CoFree CoMonad."} [a (F (CoFree F a))]) -(def: _cursor Cursor ["" 0 0]) - (macro: #export (be tokens state) {#.doc (doc "A co-monadic parallel to the 'do' macro." (let [square (function (_ n) (* n n))] @@ -46,7 +44,7 @@ (if (|> bindings list.size (n.% 2) (n.= 0)) (let [[module short] (name-of ..be) gensym (: (-> Text Code) - (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [_cursor])) + (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [.dummy-location])) g!_ (gensym "_") g!map (gensym "map") g!split (gensym "split") @@ -64,7 +62,7 @@ (list.reverse (list.as-pairs bindings)))] (#.Right [state (list (case ?name (#.Some name) - (let [name [_cursor (#.Identifier ["" name])]] + (let [name [.dummy-location (#.Identifier ["" name])]] (` ({(~ name) ({[(~ g!map) (~' unwrap) (~ g!split)] (~ body')} diff --git a/stdlib/source/lux/abstract/monad.lux b/stdlib/source/lux/abstract/monad.lux index 4c03e937c..c2b19362d 100644 --- a/stdlib/source/lux/abstract/monad.lux +++ b/stdlib/source/lux/abstract/monad.lux @@ -50,8 +50,6 @@ (-> (m (m a)) (m a))) join)) -(def: _cursor Cursor ["" 0 0]) - (macro: #export (do tokens state) {#.doc (doc "Macro for easy concatenation of monadic operations." (do monad @@ -72,7 +70,7 @@ (if (|> bindings list@size .int ("lux i64 %" +2) ("lux i64 =" +0)) (let [[module short] (name-of ..do) gensym (: (-> Text Code) - (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [_cursor])) + (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [.dummy-location])) g!_ (gensym "_") g!map (gensym "map") g!join (gensym "join") @@ -90,7 +88,7 @@ (reverse (as-pairs bindings)))] (#.Right [state (list (case ?name (#.Some name) - (let [name [_cursor (#.Identifier ["" name])]] + (let [name [.dummy-location (#.Identifier ["" name])]] (` ({(~ name) ({[(~ g!map) (~' wrap) (~ g!join)] (~ body')} diff --git a/stdlib/source/lux/control/parser/binary.lux b/stdlib/source/lux/control/parser/binary.lux index ed698ccd1..905afba3f 100644 --- a/stdlib/source/lux/control/parser/binary.lux +++ b/stdlib/source/lux/control/parser/binary.lux @@ -249,8 +249,8 @@ [9 #.Apply pair] [10 #.Named (//.and ..name type)]]))))) -(def: #export cursor - (Parser Cursor) +(def: #export location + (Parser Location) ($_ //.and ..text ..nat ..nat)) (def: #export code @@ -258,7 +258,7 @@ (..rec (function (_ recur) (let [sequence (..list recur)] - (//.and ..cursor + (//.and ..location (!variant [[0 #.Bit ..bit] [1 #.Nat ..nat] [2 #.Int ..int] diff --git a/stdlib/source/lux/control/try.lux b/stdlib/source/lux/control/try.lux index f22da7a1b..74707c51b 100644 --- a/stdlib/source/lux/control/try.lux +++ b/stdlib/source/lux/control/try.lux @@ -143,7 +143,7 @@ (#..Success (~' g!temp)) (~' g!temp) - (#..Failure (~ [dummy-cursor (#.Identifier ["" ""])])) + (#..Failure (~ [.dummy-location (#.Identifier ["" ""])])) (~ else))))]) _ diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux index ece895c38..f629f8b52 100644 --- a/stdlib/source/lux/data/format/binary.lux +++ b/stdlib/source/lux/data/format/binary.lux @@ -254,8 +254,8 @@ [10 #.Named (..and ..name recur)]) )))))) -(def: #export cursor - (Writer Cursor) +(def: #export location + (Writer Location) ($_ ..and ..text ..nat ..nat)) (def: #export code @@ -263,7 +263,7 @@ (..rec (function (_ recur) (let [sequence (..list recur)] - (..and ..cursor + (..and ..location (function (_ altV) (case altV (^template [<number> <tag> <writer>] diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux index 705e88682..db0293413 100644 --- a/stdlib/source/lux/data/lazy.lux +++ b/stdlib/source/lux/data/lazy.lux @@ -43,19 +43,26 @@ (structure: #export (equivalence (^open "_@.")) (All [a] (-> (Equivalence a) (Equivalence (Lazy a)))) + (def: (= left right) (_@= (..thaw left) (..thaw right)))) -(structure: #export functor (Functor Lazy) +(structure: #export functor + (Functor Lazy) + (def: (map f fa) (freeze (f (thaw fa))))) -(structure: #export apply (Apply Lazy) +(structure: #export apply + (Apply Lazy) + (def: &functor ..functor) (def: (apply ff fa) (freeze ((thaw ff) (thaw fa))))) -(structure: #export monad (Monad Lazy) +(structure: #export monad + (Monad Lazy) + (def: &functor ..functor) (def: wrap (|>> freeze)) (def: join thaw)) diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux index 2afd4cb60..2e7912550 100644 --- a/stdlib/source/lux/data/maybe.lux +++ b/stdlib/source/lux/data/maybe.lux @@ -123,7 +123,7 @@ +20)} (case tokens (^ (list else maybe)) - (let [g!temp (: Code [dummy-cursor (#.Identifier ["" ""])]) + (let [g!temp (: Code [.dummy-location (#.Identifier ["" ""])]) code (` (case (~ maybe) (#.Some (~ g!temp)) (~ g!temp) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 07e093849..48a931637 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -14,13 +14,13 @@ (macro: (encoding-doc tokens state) (case tokens - (^ (list [cursor (#.Text encoding)] example-1 example-2)) + (^ (list [location (#.Text encoding)] example-1 example-2)) (let [encoding ($_ "lux text concat" "Given syntax for a " encoding " number, generates a Nat, an Int, a Rev or a Frac.") commas "Allows for the presence of commas among the digits." - description [cursor (#.Text ($_ "lux text concat" encoding " " commas))]] + description [location (#.Text ($_ "lux text concat" encoding " " commas))]] (#try.Success [state (list (` (doc (~ description) (~ example-1) (~ example-2))))])) diff --git a/stdlib/source/lux/data/store.lux b/stdlib/source/lux/data/store.lux index 36cc3e67d..fa3e45f00 100644 --- a/stdlib/source/lux/data/store.lux +++ b/stdlib/source/lux/data/store.lux @@ -15,13 +15,17 @@ {#cursor (get@ #cursor wa) #peek (function (_ s) (f (set@ #cursor s wa)))}) -(structure: #export functor (All [s] (Functor (Store s))) +(structure: #export functor + (All [s] (Functor (Store s))) + (def: (map f fa) (extend (function (_ store) (f (:: store peek (:: store cursor)))) fa))) -(structure: #export comonad (All [s] (CoMonad (Store s))) +(structure: #export comonad + (All [s] (CoMonad (Store s))) + (def: &functor ..functor) (def: (unwrap wa) (::: peek (::: cursor))) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index 392e3ee42..388bd3638 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -71,7 +71,7 @@ [instant instant.Instant (:: instant.codec encode)] [duration duration.Duration (:: duration.codec encode)] [date date.Date (:: date.codec encode)] - [cursor Cursor .cursor-description] + [location Location .location-description] ) (def: #export (mod modular) diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux index 3f7e5f970..7678852a6 100644 --- a/stdlib/source/lux/macro/code.lux +++ b/stdlib/source/lux/macro/code.lux @@ -28,14 +28,12 @@ ## (#.Record (List [(w (Code' w)) (w (Code' w))]))) ## (type: Code -## (Ann Cursor (Code' (Ann Cursor)))) - -(def: _cursor Cursor ["" 0 0]) +## (Ann Location (Code' (Ann Location)))) (template [<name> <type> <tag>] [(def: #export (<name> x) (-> <type> Code) - [_cursor (<tag> x)])] + [.dummy-location (<tag> x)])] [bit Bit #.Bit] [nat Nat #.Nat] @@ -54,7 +52,7 @@ [(def: #export (<name> name) {#.doc <doc>} (-> Text Code) - [_cursor (<tag> ["" name])])] + [.dummy-location (<tag> ["" name])])] [local-identifier #.Identifier "Produces a local identifier (an identifier with no module prefix)."] [local-tag #.Tag "Produces a local tag (a tag with no module prefix)."]) @@ -143,16 +141,16 @@ substitute (case ast (^template [<tag>] - [cursor (<tag> parts)] - [cursor (<tag> (list@map (replace original substitute) parts))]) + [location (<tag> parts)] + [location (<tag> (list@map (replace original substitute) parts))]) ([#.Form] [#.Tuple]) - [cursor (#.Record parts)] - [cursor (#.Record (list@map (function (_ [left right]) - [(replace original substitute left) - (replace original substitute right)]) - parts))] + [location (#.Record parts)] + [location (#.Record (list@map (function (_ [left right]) + [(replace original substitute left) + (replace original substitute right)]) + parts))] _ ast))) diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux index 4a05763ce..ec23805c5 100644 --- a/stdlib/source/lux/meta.lux +++ b/stdlib/source/lux/meta.lux @@ -548,11 +548,11 @@ _ (wrap #.None)))) -(def: #export cursor - {#.doc "The cursor of the current expression being analyzed."} - (Meta Cursor) +(def: #export location + {#.doc "The location of the current expression being analyzed."} + (Meta Location) (function (_ compiler) - (#try.Success [compiler (get@ #.cursor compiler)]))) + (#try.Success [compiler (get@ #.location compiler)]))) (def: #export expected-type {#.doc "The expected type of the current expression being analyzed."} @@ -682,9 +682,9 @@ #.None)) (#.Some [omit? token]) (do ..monad - [cursor ..cursor + [location ..location output (<func> token) - #let [_ (log! ($_ text@compose (name@encode (name-of <macro>)) " @ " (.cursor-description cursor))) + #let [_ (log! ($_ text@compose (name@encode (name-of <macro>)) " @ " (.location-description location))) _ (list@map (|>> code.to-text log!) output) _ (log! "")]] diff --git a/stdlib/source/lux/target/js.lux b/stdlib/source/lux/target/js.lux index 16a6d77da..bc4b3949d 100644 --- a/stdlib/source/lux/target/js.lux +++ b/stdlib/source/lux/target/js.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Code or and function if cond undefined for comment not int) + [lux (#- Location Code or and function if cond undefined for comment not int) [control [pipe (#+ case>)]] [data diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index f25f22035..ed4150b73 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -79,7 +79,7 @@ (type: Reader (-> Source (Either [Source Text] [Source Code]))) -(def: (reader current-module aliases [cursor offset source-code]) +(def: (reader current-module aliases [location offset source-code]) (-> Module Aliases Source (///analysis.Operation Reader)) (function (_ [bundle state]) (#try.Success [[bundle state] @@ -93,10 +93,10 @@ (#try.Failure error) (#.Right [source' output]) - (let [[cursor _] output] + (let [[location _] output] (#try.Success [[bundle (|> compiler (set@ #.source source') - (set@ #.cursor cursor))] + (set@ #.location location))] [source' output]]))))) (type: (Operation a) diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux index 598f34db5..96296a39a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux @@ -441,29 +441,29 @@ (set@ #.current-module) (function.constant (#.Some name)))) -(def: #export (with-cursor cursor action) - (All [a] (-> Cursor (Operation a) (Operation a))) - (if (text@= "" (product.left cursor)) +(def: #export (with-location location action) + (All [a] (-> Location (Operation a) (Operation a))) + (if (text@= "" (product.left location)) action (function (_ [bundle state]) - (let [old-cursor (get@ #.cursor state)] - (case (action [bundle (set@ #.cursor cursor state)]) + (let [old-location (get@ #.location state)] + (case (action [bundle (set@ #.location location state)]) (#try.Success [[bundle' state'] output]) - (#try.Success [[bundle' (set@ #.cursor old-cursor state')] + (#try.Success [[bundle' (set@ #.location old-location state')] output]) (#try.Failure error) (#try.Failure error)))))) -(def: (locate-error cursor error) - (-> Cursor Text Text) - (format "@ " (%.cursor cursor) text.new-line +(def: (locate-error location error) + (-> Location Text Text) + (format "@ " (%.location location) text.new-line error)) (def: #export (fail error) (-> Text Operation) (function (_ [bundle state]) - (#try.Failure (locate-error (get@ #.cursor state) error)))) + (#try.Failure (locate-error (get@ #.location state) error)))) (def: #export (throw exception parameters) (All [e] (-> (Exception e) e Operation)) @@ -478,7 +478,7 @@ (def: #export (fail' error) (-> Text (phase.Operation Lux)) (function (_ state) - (#try.Failure (locate-error (get@ #.cursor state) error)))) + (#try.Failure (locate-error (get@ #.location state) error)))) (def: #export (throw' exception parameters) (All [e] (-> (Exception e) e (phase.Operation Lux))) @@ -494,7 +494,7 @@ (#try.Failure error) (let [[bundle state] bundle,state] - (#try.Failure (locate-error (get@ #.cursor state) error)))))) + (#try.Failure (locate-error (get@ #.location state) error)))))) (def: #export (install state) (-> .Lux (Operation Any)) @@ -507,22 +507,22 @@ (-> <type> (Operation Any)) (extension.update (set@ <field> <value>)))] - [set-source-code Source #.source value] - [set-current-module Text #.current-module (#.Some value)] - [set-cursor Cursor #.cursor value] + [set-source-code Source #.source value] + [set-current-module Text #.current-module (#.Some value)] + [set-location Location #.location value] ) -(def: #export (cursor file) - (-> Text Cursor) +(def: #export (location file) + (-> Text Location) [file 1 0]) (def: #export (source file code) (-> Text Text Source) - [(cursor file) 0 code]) + [(location file) 0 code]) (def: dummy-source Source - [.dummy-cursor 0 ""]) + [.dummy-location 0 ""]) (def: type-context Type-Context @@ -540,7 +540,7 @@ (-> Info Lux) {#.info info #.source ..dummy-source - #.cursor .dummy-cursor + #.location .dummy-location #.current-module #.None #.modules (list) #.scopes (list) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux index 8ca459028..a5978fcba 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux @@ -36,7 +36,7 @@ (-> a a)) (def: (compile|primitive else code') - (Fix (-> (Code' (Ann Cursor)) (Operation Analysis))) + (Fix (-> (Code' (Ann Location)) (Operation Analysis))) (case code' (^template [<tag> <analyser>] (<tag> value) @@ -52,7 +52,7 @@ (else code'))) (def: (compile|structure archive compile else code') - (-> Archive Phase (Fix (-> (Code' (Ann Cursor)) (Operation Analysis)))) + (-> Archive Phase (Fix (-> (Code' (Ann Location)) (Operation Analysis)))) (case code' (^ (#.Form (list& [_ (#.Tag tag)] values))) @@ -91,7 +91,7 @@ (else code'))) (def: (compile|others expander archive compile code') - (-> Expander Archive Phase (-> (Code' (Ann Cursor)) (Operation Analysis))) + (-> Expander Archive Phase (-> (Code' (Ann Location)) (Operation Analysis))) (case code' (#.Identifier reference) (/reference.reference reference) @@ -128,15 +128,15 @@ (/function.apply compile argsC+ functionT functionA archive functionC))) _ - (//.throw unrecognized-syntax [.dummy-cursor code']))) + (//.throw unrecognized-syntax [.dummy-location code']))) (def: #export (phase expander) (-> Expander Phase) (function (compile archive code) - (let [[cursor code'] code] - ## The cursor must be set in the state for the sake + (let [[location code'] code] + ## The location must be set in the state for the sake ## of having useful error messages. - (/.with-cursor cursor + (/.with-location location (compile|primitive (compile|structure archive compile (compile|others expander archive compile)) code'))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux index 01afd6142..3c563d300 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -131,9 +131,9 @@ _ (:: ///.monad wrap (re-quantify envs caseT))))) -(def: (analyse-primitive type inputT cursor output next) - (All [a] (-> Type Type Cursor Pattern (Operation a) (Operation [Pattern a]))) - (/.with-cursor cursor +(def: (analyse-primitive type inputT location output next) + (All [a] (-> Type Type Location Pattern (Operation a) (Operation [Pattern a]))) + (/.with-location location (do ///.monad [_ (//type.with-env (check.check inputT type)) @@ -159,8 +159,8 @@ (def: (analyse-pattern num-tags inputT pattern next) (All [a] (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))) (.case pattern - [cursor (#.Identifier ["" name])] - (/.with-cursor cursor + [location (#.Identifier ["" name])] + (/.with-location location (do ///.monad [outputA (//scope.with-local [name inputT] next) @@ -168,8 +168,8 @@ (wrap [(#/.Bind idx) outputA]))) (^template [<type> <input> <output>] - [cursor <input>] - (analyse-primitive <type> inputT cursor (#/.Simple <output>) next)) + [location <input>] + (analyse-primitive <type> inputT location (#/.Simple <output>) next)) ([Bit (#.Bit pattern-value) (#/.Bit pattern-value)] [Nat (#.Nat pattern-value) (#/.Nat pattern-value)] [Int (#.Int pattern-value) (#/.Int pattern-value)] @@ -178,11 +178,11 @@ [Text (#.Text pattern-value) (#/.Text pattern-value)] [Any (#.Tuple #.Nil) #/.Unit]) - (^ [cursor (#.Tuple (list singleton))]) + (^ [location (#.Tuple (list singleton))]) (analyse-pattern #.None inputT singleton next) - [cursor (#.Tuple sub-patterns)] - (/.with-cursor cursor + [location (#.Tuple sub-patterns)] + (/.with-location location (do {@ ///.monad} [inputT' (simplify-case inputT)] (.case inputT' @@ -222,7 +222,7 @@ (/.throw ..cannot-match-with-pattern [inputT' pattern]) ))) - [cursor (#.Record record)] + [location (#.Record record)] (do ///.monad [record (//structure.normalize record) [members recordT] (//structure.order record) @@ -233,14 +233,14 @@ _ (wrap []))] - (analyse-pattern (#.Some (list.size members)) inputT [cursor (#.Tuple members)] next)) + (analyse-pattern (#.Some (list.size members)) inputT [location (#.Tuple members)] next)) - [cursor (#.Tag tag)] - (/.with-cursor cursor + [location (#.Tag tag)] + (/.with-location location (analyse-pattern #.None inputT (` ((~ pattern))) next)) - (^ [cursor (#.Form (list& [_ (#.Nat lefts)] [_ (#.Bit right?)] values))]) - (/.with-cursor cursor + (^ [location (#.Form (list& [_ (#.Nat lefts)] [_ (#.Bit right?)] values))]) + (/.with-location location (do ///.monad [inputT' (simplify-case inputT)] (.case inputT' @@ -278,8 +278,8 @@ _ (/.throw ..cannot-match-with-pattern [inputT' pattern])))) - (^ [cursor (#.Form (list& [_ (#.Tag tag)] values))]) - (/.with-cursor cursor + (^ [location (#.Form (list& [_ (#.Tag tag)] values))]) + (/.with-location location (do ///.monad [tag (///extension.lift (macro.normalize tag)) [idx group variantT] (///extension.lift (macro.resolve-tag tag)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux index 38f1d3bd3..bcde262d2 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux @@ -86,17 +86,17 @@ _ type)) -(def: (named-type cursor id) - (-> Cursor Nat Type) - (let [name (format "{New Type @ " (.cursor-description cursor) " " (%.nat id) "}")] +(def: (named-type location id) + (-> Location Nat Type) + (let [name (format "{New Type @ " (.location-description location) " " (%.nat id) "}")] (#.Primitive name (list)))) (def: new-named-type (Operation Type) (do ///.monad - [cursor (///extension.lift macro.cursor) + [location (///extension.lift macro.location) [ex-id _] (//type.with-env check.existential)] - (wrap (named-type cursor ex-id)))) + (wrap (named-type location ex-id)))) ## Type-inference works by applying some (potentially quantified) type ## to a sequence of values. diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux index 988d599b7..55cd0d1b5 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux @@ -34,7 +34,7 @@ (exception.report ["Name" (%.name name)])) -(with-expansions [<lux_def_module> (as-is [|form-cursor| (#.Form (list& [|text-cursor| (#.Text "lux def module")] annotations))])] +(with-expansions [<lux_def_module> (as-is [|form-location| (#.Form (list& [|text-location| (#.Text "lux def module")] annotations))])] (def: #export (phase expander) (-> Expander Phase) (let [analyze (//analysis.phase expander)] diff --git a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux index 8b6808a2c..eb85bc9ca 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux @@ -8,20 +8,20 @@ ## its position within the input data. ## That is, the parser takes into account the line and column ## information in the input text (it doesn't really touch the -## file-name aspect of the cursor, leaving it intact in whatever -## base-line cursor it is given). +## file-name aspect of the location, leaving it intact in whatever +## base-line location it is given). ## This particular piece of functionality is not located in one ## function, but it is instead scattered throughout several parsers, -## since the logic for how to update the cursor varies, depending on +## since the logic for how to update the location varies, depending on ## what is being parsed, and the rules involved. ## You will notice that several parsers have a "where" parameter, that -## tells them the cursor position prior to the parser being run. +## tells them the location position prior to the parser being run. ## They are supposed to produce some parsed output, alongside an -## updated cursor pointing to the end position, after the parser was run. +## updated location pointing to the end position, after the parser was run. -## Lux Code nodes/tokens are annotated with cursor meta-data +## Lux Code nodes/tokens are annotated with location meta-data ## [file-name, line, column] to keep track of their provenance and ## location, which is helpful for documentation and debugging. (.module: @@ -54,10 +54,10 @@ ## TODO: Make an extension to take advantage of java/lang/String::indexOf<int,int> ## to get better performance than the current "lux text index" extension. -## TODO: Instead of always keeping a "where" cursor variable, keep the +## TODO: Instead of always keeping a "where" location variable, keep the ## individual components (i.e. file, line and column) separate, so ## that updated the "where" only involved updating the components, and -## producing the cursors only involved building them, without any need +## producing the locations only involved building them, without any need ## for pattern-matching and de-structuring. (type: Char Nat) @@ -137,7 +137,7 @@ (let [end (|> start (!n/+ amount-of-input-shown) (n.min ("lux text size" input)))] (!clip start end input))) -(exception: #export (unrecognized-input {[file line column] Cursor} {context Text} {input Text} {offset Offset}) +(exception: #export (unrecognized-input {[file line column] Location} {context Text} {input Text} {offset Offset}) (exception.report ["File" file] ["Line" (%.nat line)] @@ -184,12 +184,12 @@ source-code]) (template: (!new-line where) - ## (-> Cursor Cursor) + ## (-> Location Location) (let [[where::file where::line where::column] where] [where::file (!inc where::line) 0])) (template: (!forward length where) - ## (-> Nat Cursor Cursor) + ## (-> Nat Location Location) (let [[where::file where::line where::column] where] [where::file where::line (!n/+ length where::column)])) @@ -251,7 +251,7 @@ (exception.construct ..text-cannot-contain-new-lines content)]))) (def: (parse-text where offset source-code) - (-> Cursor Nat Text (Either [Source Text] [Source Code])) + (-> Location Nat Text (Either [Source Text] [Source Code])) (case ("lux text index" offset (static ..text-delimiter) source-code) (#.Some g!end) (let [g!content (!clip offset g!end source-code)] @@ -361,7 +361,7 @@ (template [<parser> <codec> <tag>] [(def: (<parser> source-code//size start where offset source-code) - (-> Nat Nat Cursor Nat Text (Either [Source Text] [Source Code])) + (-> Nat Nat Location Nat Text (Either [Source Text] [Source Code])) (loop [g!end offset] (<| (!with-char+ source-code//size source-code g!end g!char (!number-output start g!end <codec> <tag>)) (if (!digit?+ g!char) diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index ed0dc3ce9..f7170adc4 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -358,10 +358,10 @@ (case input (#.Left valueN) (do meta.monad - [cursor meta.cursor + [location meta.location valueT (meta.find-type valueN) #let [_ (log! ($_ text@compose - (name@encode (name-of ..:log!)) " @ " (.cursor-description cursor) text.new-line + (name@encode (name-of ..:log!)) " @ " (.location-description location) text.new-line "Value: " (name@encode valueN) text.new-line " Type: " (..to-text valueT) text.new-line))]] (wrap (list (code.identifier valueN)))) @@ -419,13 +419,13 @@ {(~ extraction) (:assume [])})))))) -(exception: #export (hole-type {location Cursor} {type Type}) +(exception: #export (hole-type {location Location} {type Type}) (exception.report - ["Location" (.cursor-description location)] + ["Location" (.location-description location)] ["Type" (..to-text type)])) (syntax: #export (:hole) (do meta.monad - [cursor meta.cursor + [location meta.location expectedT meta.expected-type] - (meta.fail (exception.construct ..hole-type [cursor expectedT])))) + (meta.fail (exception.construct ..hole-type [location expectedT])))) diff --git a/stdlib/source/test/aedifex/parser.lux b/stdlib/source/test/aedifex/parser.lux index 497533fbf..97895a201 100644 --- a/stdlib/source/test/aedifex/parser.lux +++ b/stdlib/source/test/aedifex/parser.lux @@ -205,7 +205,9 @@ (def: #export test Test (<| (_.covering /._) - (_.with-cover [/.project] + (_.covering //format._) + (_.with-cover [/.project + //format.Format //format.profile //format.project] ($_ _.and ..single-profile ..multiple-profiles diff --git a/stdlib/source/test/lux/control/parser/binary.lux b/stdlib/source/test/lux/control/parser/binary.lux index 8bc24976e..11875d19f 100644 --- a/stdlib/source/test/lux/control/parser/binary.lux +++ b/stdlib/source/test/lux/control/parser/binary.lux @@ -69,8 +69,8 @@ (Random Name) (random.and ..random-text ..random-text)) -(structure: cursor-equivalence - (Equivalence Cursor) +(structure: location-equivalence + (Equivalence Location) (def: (= [expected-module expected-line expected-column] [sample-module sample-line sample-column]) @@ -78,8 +78,8 @@ (n.= expected-line sample-line) (n.= expected-column sample-column)))) -(def: random-cursor - (Random Cursor) +(def: random-location + (Random Location) ($_ random.and ..random-text random.nat @@ -93,8 +93,8 @@ [size (:: @ map (n.% 2) random.nat)] (random.list size recur))] ($_ random.and - ..random-cursor - (: (Random (Code' (Ann Cursor))) + ..random-location + (: (Random (Code' (Ann Location))) ($_ random.or random.bit random.nat @@ -240,7 +240,7 @@ (!expect (^multi (#try.Success actual) (:: <equivalence> = expected actual))))))] - [/.cursor format.cursor random-cursor cursor-equivalence] + [/.location format.location random-location location-equivalence] [/.code format.code random-code code.equivalence] [/.type format.type random-type type.equivalence] )) diff --git a/stdlib/source/test/lux/data/lazy.lux b/stdlib/source/test/lux/data/lazy.lux index b31953a9f..440aa0316 100644 --- a/stdlib/source/test/lux/data/lazy.lux +++ b/stdlib/source/test/lux/data/lazy.lux @@ -10,11 +10,10 @@ ["$." monad] ["$." equivalence]]}] [data - ["%" text/format (#+ format)] [number ["n" nat]]] [math - ["r" random (#+ Random)]]] + ["." random (#+ Random)]]] {1 ["." / (#+ Lazy)]}) @@ -29,28 +28,35 @@ (def: #export lazy (All [a] (-> (Random a) (Random (Lazy a)))) - (:: r.functor map (|>> /.freeze))) + (:: random.functor map (|>> /.freeze))) (def: #export test Test - (<| (_.context (%.name (name-of /.Lazy))) - (do r.monad - [left r.nat - right r.nat - #let [lazy (/.freeze (n.* left right)) - expected (n.* left right)]] - ($_ _.and - ($equivalence.spec (/.equivalence n.equivalence) (..lazy r.nat)) - ($functor.spec ..injection ..comparison /.functor) - ($apply.spec ..injection ..comparison /.apply) - ($monad.spec ..injection ..comparison /.monad) + (<| (_.covering /._) + (do random.monad + [left random.nat + right random.nat + #let [expected (n.* left right)]] + (_.with-cover [/.Lazy] + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (..lazy random.nat))) + (_.with-cover [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.with-cover [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.with-cover [/.monad] + ($monad.spec ..injection ..comparison /.monad)) - (_.test "Freezing does not alter the expected value." - (n.= expected - (/.thaw lazy))) - (_.test "Lazy values only evaluate once." - (and (not (is? expected - (/.thaw lazy))) - (is? (/.thaw lazy) + (_.cover [/.freeze] + (let [lazy (/.freeze (n.* left right))] + (n.= expected (/.thaw lazy)))) - )))) + + (_.cover [/.thaw] + (let [lazy (/.freeze (n.* left right))] + (and (not (is? expected + (/.thaw lazy))) + (is? (/.thaw lazy) + (/.thaw lazy))))) + ))))) diff --git a/stdlib/source/test/lux/data/maybe.lux b/stdlib/source/test/lux/data/maybe.lux index a10e0154e..24114f6c0 100644 --- a/stdlib/source/test/lux/data/maybe.lux +++ b/stdlib/source/test/lux/data/maybe.lux @@ -6,6 +6,7 @@ {[0 #spec] [/ ["$." equivalence] + ["$." monoid] ["$." functor] ["$." apply] ["$." monad]]}] @@ -13,58 +14,64 @@ ["." io ("#@." monad)] pipe] [data - ["." text - ["%" format (#+ format)]] + ["." text] [number - ["n" nat]]] + ["n" nat]] + [collection + ["." list]]] [math - ["r" random (#+ Random)]]] + ["." random (#+ Random)]]] {1 ["." / ("#@." monoid monad)]}) -(def: #export maybe - (All [a] (-> (Random a) (Random (Maybe a)))) - (:: r.functor map (|>> #.Some))) - (def: #export test Test - (<| (_.context (%.name (name-of .Maybe))) - ($_ _.and - ($equivalence.spec (/.equivalence n.equivalence) (..maybe r.nat)) - ($functor.spec /@wrap /.equivalence /.functor) - ($apply.spec /@wrap /.equivalence /.apply) - ($monad.spec /@wrap /.equivalence /.monad) - - (do r.monad - [left r.nat - right r.nat - #let [expected (n.+ left right)]] - (let [lift (/.lift io.monad)] - (_.test "Can add maybe functionality to any monad." - (|> (io.run (do (/.with io.monad) - [a (lift (io@wrap left)) - b (wrap right)] - (wrap (n.+ a b)))) - (case> (#.Some actual) - (n.= expected actual) + (<| (_.covering /._) + (_.with-cover [.Maybe] + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (random.maybe random.nat))) + (_.with-cover [/.monoid] + ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.maybe random.nat))) + (_.with-cover [/.functor] + ($functor.spec /@wrap /.equivalence /.functor)) + (_.with-cover [/.apply] + ($apply.spec /@wrap /.equivalence /.apply)) + (_.with-cover [/.monad] + ($monad.spec /@wrap /.equivalence /.monad)) + + (do random.monad + [left random.nat + right random.nat + #let [expected (n.+ left right)]] + (let [lift (/.lift io.monad)] + (_.cover [/.with /.lift] + (|> (io.run (do (/.with io.monad) + [a (lift (io@wrap left)) + b (wrap right)] + (wrap (n.+ a b)))) + (case> (#.Some actual) + (n.= expected actual) - _ - false))))) - (let [(^open "/@.") (/.equivalence text.equivalence) - (^open "/@.") /.monoid] - (_.test "Monoid respects Maybe." - (and (/@= #.None /@identity) - (/@= (#.Some "yolo") (/@compose (#.Some "yolo") (#.Some "lol"))) - (/@= (#.Some "yolo") (/@compose (#.Some "yolo") #.None)) - (/@= (#.Some "lol") (/@compose #.None (#.Some "lol"))) - (/@= #.None (: (Maybe Text) (/@compose #.None #.None)))))) - (do r.monad - [default r.nat - value r.nat] - (_.test "Can have defaults for Maybe values." - (and (is? default (/.default default - #.None)) + _ + false))))) + (do random.monad + [default random.nat + value random.nat] + (_.cover [/.default] + (and (is? default (/.default default + #.None)) - (is? value (/.default default - (#.Some value)))))) - ))) + (is? value (/.default default + (#.Some value)))))) + (do random.monad + [value random.nat] + (_.cover [/.assume] + (is? value (/.assume (#.Some value))))) + (do random.monad + [value random.nat] + (_.cover [/.to-list] + (:: (list.equivalence n.equivalence) = + (list value) + (/.to-list (#.Some value))))) + )))) diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index 0cdbc9610..eec419644 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -69,7 +69,7 @@ syntax.no-aliases (text.size source-code)) start (: Source - [.dummy-cursor 0 source-code])] + [.dummy-location 0 source-code])] (case (parse start) (#.Left [end error]) (#try.Failure error) @@ -132,7 +132,7 @@ (#try.Failure error) false) (:: /.equivalence = - [.dummy-cursor (<tag> expected)] + [.dummy-location (<tag> expected)] (<coverage> expected)))))] [/.bit random.bit #.Bit] @@ -159,7 +159,7 @@ (#try.Failure error) false) (:: /.equivalence = - [.dummy-cursor (<tag> ["" expected])] + [.dummy-location (<tag> ["" expected])] (<coverage> expected))) ))] diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index ec400d5e3..1f5e2c5fa 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -46,8 +46,8 @@ #let [expected-lux {#.info {#.target target #.version version #.mode #.Build} - #.source [..dummy-cursor 0 source-code] - #.cursor ..dummy-cursor + #.source [.dummy-location 0 source-code] + #.location .dummy-location #.current-module (#.Some expected-current-module) #.modules (list) #.scopes (list) @@ -93,8 +93,8 @@ #let [expected-lux {#.info {#.target target #.version version #.mode #.Build} - #.source [..dummy-cursor 0 source-code] - #.cursor ..dummy-cursor + #.source [.dummy-location 0 source-code] + #.location .dummy-location #.current-module (#.Some expected-current-module) #.modules (list) #.scopes (list) @@ -167,8 +167,8 @@ #let [expected-lux {#.info {#.target target #.version version #.mode #.Build} - #.source [..dummy-cursor 0 source-code] - #.cursor ..dummy-cursor + #.source [.dummy-location 0 source-code] + #.location .dummy-location #.current-module (#.Some expected-current-module) #.modules (list) #.scopes (list) @@ -199,8 +199,8 @@ (is? expected-short actual-short))))))) ))) -(def: random-cursor - (Random Cursor) +(def: random-location + (Random Location) ($_ random.and (random.ascii/upper-alpha 1) random.nat @@ -241,12 +241,12 @@ dummy-module (random.filter (|>> (text@= expected-current-module) not) (random.ascii/upper-alpha 1)) expected-gensym (random.ascii/upper-alpha 1) - expected-cursor ..random-cursor + expected-location ..random-location #let [expected-lux {#.info {#.target target #.version version #.mode #.Build} - #.source [.dummy-cursor 0 source-code] - #.cursor expected-cursor + #.source [.dummy-location 0 source-code] + #.location expected-location #.current-module (#.Some expected-current-module) #.modules (list) #.scopes (list) @@ -285,11 +285,11 @@ (!expect (^multi (#try.Success actual-gensym) (and (text.contains? expected-gensym actual-gensym) (text.contains? (%.nat expected-seed) actual-gensym)))))) - (_.cover [/.cursor] - (|> /.cursor + (_.cover [/.location] + (|> /.location (/.run expected-lux) - (!expect (^multi (#try.Success actual-cursor) - (is? expected-cursor actual-cursor))))) + (!expect (^multi (#try.Success actual-location) + (is? expected-location actual-location))))) (_.cover [/.expected-type] (|> /.expected-type (/.run expected-lux) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux index 103dc069e..c6ac62bc5 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux @@ -22,12 +22,6 @@ {1 ["." /]}) -(def: default-cursor - Cursor - {#.module "" - #.line 0 - #.column 0}) - (def: name-part^ (Random Text) (do {@ r.monad} @@ -83,7 +77,7 @@ (_.test "Can parse Lux code." (case (let [source-code (%.code sample)] (/.parse "" (dictionary.new text.hash) (text.size source-code) - [default-cursor 0 source-code])) + [.dummy-location 0 source-code])) (#.Left error) false @@ -95,7 +89,7 @@ (let [source-code (format (%.code sample) " " (%.code other)) source-code//size (text.size source-code)] (case (/.parse "" (dictionary.new text.hash) source-code//size - [default-cursor 0 source-code]) + [.dummy-location 0 source-code]) (#.Left error) false @@ -133,7 +127,7 @@ (case (let [source-code (format comment (%.code sample)) source-code//size (text.size source-code)] (/.parse "" (dictionary.new text.hash) source-code//size - [default-cursor 0 source-code])) + [.dummy-location 0 source-code])) (#.Left error) false |