diff options
author | Eduardo Julian | 2020-10-07 20:53:30 -0400 |
---|---|---|
committer | Eduardo Julian | 2020-10-07 20:53:30 -0400 |
commit | 24ba990800665299b551e66d1bc3d89c96ff6c55 (patch) | |
tree | 4aade042f9fe69e1c9a28e728f5cd6ddeaba13d5 /stdlib/source/lux/tool | |
parent | ce7614f00a134cb61b4a6f88cfea33461a7bf478 (diff) |
Re-named "Cursor" type to "Location".
Diffstat (limited to 'stdlib/source/lux/tool')
7 files changed, 67 insertions, 67 deletions
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) |