diff options
Diffstat (limited to 'luxc')
-rw-r--r-- | luxc/src/lux/analyser.clj | 72 | ||||
-rw-r--r-- | luxc/src/lux/analyser/base.clj | 8 | ||||
-rw-r--r-- | luxc/src/lux/analyser/env.clj | 8 | ||||
-rw-r--r-- | luxc/src/lux/analyser/function.clj | 4 | ||||
-rw-r--r-- | luxc/src/lux/analyser/lux.clj | 92 | ||||
-rw-r--r-- | luxc/src/lux/analyser/proc/common.clj | 74 | ||||
-rw-r--r-- | luxc/src/lux/analyser/proc/jvm.clj | 114 | ||||
-rw-r--r-- | luxc/src/lux/base.clj | 50 | ||||
-rw-r--r-- | luxc/src/lux/compiler/cache/ann.clj | 8 | ||||
-rw-r--r-- | luxc/src/lux/compiler/jvm.clj | 2 | ||||
-rw-r--r-- | luxc/src/lux/compiler/jvm/function.clj | 2 | ||||
-rw-r--r-- | luxc/src/lux/compiler/jvm/lux.clj | 4 | ||||
-rw-r--r-- | luxc/src/lux/compiler/jvm/proc/host.clj | 12 | ||||
-rw-r--r-- | luxc/src/lux/repl.clj | 8 | ||||
-rw-r--r-- | luxc/src/lux/type.clj | 72 |
15 files changed, 265 insertions, 265 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))) _ |