aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/tool
diff options
context:
space:
mode:
authorEduardo Julian2020-10-07 20:53:30 -0400
committerEduardo Julian2020-10-07 20:53:30 -0400
commit24ba990800665299b551e66d1bc3d89c96ff6c55 (patch)
tree4aade042f9fe69e1c9a28e728f5cd6ddeaba13d5 /stdlib/source/lux/tool
parentce7614f00a134cb61b4a6f88cfea33461a7bf478 (diff)
Re-named "Cursor" type to "Location".
Diffstat (limited to 'stdlib/source/lux/tool')
-rw-r--r--stdlib/source/lux/tool/compiler/default/init.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/analysis.lux40
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux14
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux36
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux10
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/syntax.lux26
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)