aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/program.lux10
-rw-r--r--stdlib/source/lux/compiler/default.lux17
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension.lux3
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/statement.lux76
-rw-r--r--stdlib/source/lux/compiler/default/syntax.lux75
5 files changed, 94 insertions, 87 deletions
diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux
index 1084c18b2..ebc94cacb 100644
--- a/new-luxc/source/program.lux
+++ b/new-luxc/source/program.lux
@@ -5,7 +5,7 @@
["p" parser]]
[data
["." error]
- [text
+ ["." text
format]]
["." io (#+ IO Process io)]
[time
@@ -35,9 +35,9 @@
[?output action]
(case ?output
(#error.Error error)
- (exec (log! (format "\n"
- failure-description "\n"
- error "\n"))
+ (exec (log! (format text.new-line
+ failure-description text.new-line
+ error text.new-line))
(io.exit +1))
(#error.Success output)
@@ -51,7 +51,7 @@
result action
finish (io.from-io instant.now)
#let [elapsed-time (instant.span start finish)
- _ (log! (format "\n" "Elapsed time: " (%duration elapsed-time)))]]
+ _ (log! (format text.new-line "Elapsed time: " (%duration elapsed-time)))]]
(wrap result)))
(def: jvm-platform
diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux
index 9c7b7868d..2b8aeb0a8 100644
--- a/stdlib/source/lux/compiler/default.lux
+++ b/stdlib/source/lux/compiler/default.lux
@@ -36,6 +36,9 @@
## [cache/io])
)
+(exception: #export (cannot-compile-module {name Text})
+ (ex.report ["Module" name]))
+
(type: Reader
(-> .Source (Error [.Source Code])))
@@ -101,13 +104,11 @@
(def: (module-compilation-iteration reader)
(-> Reader (All [anchor expression statement] <Operation>))
- (<| (phase.timed (name-of ..module-compilation-iteration) "ITERATION")
- (do phase.Monad<Operation>
- [code (statement.lift-analysis
- (..read reader))
- _ (<| (phase.timed (name-of ..module-compilation-iteration) "PHASE")
- (totalS.phase code))]
- init.refresh)))
+ (do phase.Monad<Operation>
+ [code (statement.lift-analysis
+ (..read reader))
+ _ (totalS.phase code)]
+ init.refresh))
(def: (module-compilation-loop module-name)
(All [anchor expression statement]
@@ -124,7 +125,7 @@
(#error.Error error)
(if (ex.match? syntax.end-of-file error)
(#error.Success [state []])
- (#error.Error error)))))))
+ (ex.with-stack ..cannot-compile-module module-name (#error.Error error))))))))
(def: (perform-module-compilation module-name source)
(All [anchor expression statement]
diff --git a/stdlib/source/lux/compiler/default/phase/extension.lux b/stdlib/source/lux/compiler/default/phase/extension.lux
index f5baf2a5b..ba3180500 100644
--- a/stdlib/source/lux/compiler/default/phase/extension.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension.lux
@@ -75,8 +75,7 @@
(function (_ (^@ stateE [bundle state]))
(case (dictionary.get name bundle)
(#.Some handler)
- ((<| (//.timed (name-of ..apply) (%t name))
- ((handler name phase) parameters))
+ (((handler name phase) parameters)
stateE)
#.None
diff --git a/stdlib/source/lux/compiler/default/phase/extension/statement.lux b/stdlib/source/lux/compiler/default/phase/extension/statement.lux
index 051d264c2..e5963e96c 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/statement.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/statement.lux
@@ -51,53 +51,47 @@
(All [anchor expression statement]
(-> Name (Maybe Type) Code
(Operation anchor expression statement [Type expression Text Any])))
- (<| (///.timed name "DEFINE")
- (do ///.Monad<Operation>
- [state (//.lift ///.get-state)
- #let [analyse (get@ [#statement.analysis #statement.phase] state)
- synthesize (get@ [#statement.synthesis #statement.phase] state)
- translate (get@ [#statement.translation #statement.phase] state)]
- [_ code//type codeA] (<| (///.timed name "analysis")
- (statement.lift-analysis
- (analysis.with-scope
- (type.with-fresh-env
- (case ?type
- (#.Some type)
- (type.with-type type
- (do @
- [codeA (analyse codeC)]
- (wrap [type codeA])))
-
- #.None
- (do @
- [[code//type codeA] (type.with-inference (analyse codeC))
- code//type (type.with-env
- (check.clean code//type))]
- (wrap [code//type codeA])))))))
- codeS (<| (///.timed name "synthesis")
- (statement.lift-synthesis
- (synthesize codeA)))]
- (statement.lift-translation
- (translation.with-buffer
- (do @
- [codeT (<| (///.timed name "translation")
- (translate codeS))
- codeN+V (<| (///.timed name "evaluation")
- (translation.define! name codeT))]
- (wrap [code//type codeT codeN+V])))))))
+ (do ///.Monad<Operation>
+ [state (//.lift ///.get-state)
+ #let [analyse (get@ [#statement.analysis #statement.phase] state)
+ synthesize (get@ [#statement.synthesis #statement.phase] state)
+ translate (get@ [#statement.translation #statement.phase] state)]
+ [_ code//type codeA] (statement.lift-analysis
+ (analysis.with-scope
+ (type.with-fresh-env
+ (case ?type
+ (#.Some type)
+ (type.with-type type
+ (do @
+ [codeA (analyse codeC)]
+ (wrap [type codeA])))
+
+ #.None
+ (do @
+ [[code//type codeA] (type.with-inference (analyse codeC))
+ code//type (type.with-env
+ (check.clean code//type))]
+ (wrap [code//type codeA]))))))
+ codeS (statement.lift-synthesis
+ (synthesize codeA))]
+ (statement.lift-translation
+ (translation.with-buffer
+ (do @
+ [codeT (translate codeS)
+ codeN+V (translation.define! name codeT)]
+ (wrap [code//type codeT codeN+V]))))))
(def: lux::def
Handler
(function (_ extension-name phase inputsC+)
(case inputsC+
- (^ (list [_ (#.Identifier ["" def-name])] valueC annotationsC))
+ (^ (list [_ (#.Identifier ["" short-name])] valueC annotationsC))
(do ///.Monad<Operation>
- [[_ annotationsT annotationsV] (evaluate! Code annotationsC)
+ [current-module (statement.lift-analysis
+ (//.lift macro.current-module-name))
+ #let [full-name [current-module short-name]]
+ [_ annotationsT annotationsV] (evaluate! Code annotationsC)
#let [annotationsV (:coerce Code annotationsV)]
- current-module (statement.lift-analysis
- (//.lift
- macro.current-module-name))
- #let [full-name [current-module def-name]]
[value//type valueT valueN valueV] (define! full-name
(if (macro.type? annotationsV)
(#.Some Type)
@@ -105,7 +99,7 @@
valueC)
_ (statement.lift-analysis
(do @
- [_ (module.define def-name [value//type annotationsV valueV])]
+ [_ (module.define short-name [value//type annotationsV valueV])]
(if (macro.type? annotationsV)
(case (macro.declared-tags annotationsV)
#.Nil
diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux
index 5ada2ad23..5e1990393 100644
--- a/stdlib/source/lux/compiler/default/syntax.lux
+++ b/stdlib/source/lux/compiler/default/syntax.lux
@@ -122,13 +122,17 @@
(def: amount-of-input-shown 64)
+(def: (input-at start input)
+ (-> Offset Text Text)
+ (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})
- (let [end-offset (|> offset (n/+ amount-of-input-shown) (n/min ("lux text size" input)))]
- (ex.report ["File" file]
- ["Line" (%n line)]
- ["Column" (%n column)]
- ["Context" (%t context)]
- ["Input" (!clip offset end-offset input)])))
+ (ex.report ["File" file]
+ ["Line" (%n line)]
+ ["Column" (%n column)]
+ ["Context" (%t context)]
+ ["Input" (input-at offset input)]))
(exception: #export (text-cannot-contain-new-lines {text Text})
(ex.report ["Text" (%t text)]))
@@ -136,8 +140,10 @@
(exception: #export (invalid-escape-syntax)
"")
-(exception: #export (cannot-close-composite-expression {closing-char Char})
- (ex.report ["Closing Character" (text.from-code closing-char)]))
+(exception: #export (cannot-close-composite-expression {closing-char Char} {source-code Text} {offset Offset})
+ (ex.report ["Closing Character" (text.from-code closing-char)]
+ ["Input" (format text.new-line
+ (input-at offset source-code))]))
(type: Parser
(-> Source (Error [Source Code])))
@@ -154,20 +160,21 @@
(def: close-signal "CLOSE")
-(def: (read-close closing-char source-code//size source-code offset)
- (-> Char Nat Text Offset (Error Offset))
- (loop [end offset]
- (<| (!with-char+ source-code//size source-code end char (ex.throw cannot-close-composite-expression closing-char)
- (if (!n/= closing-char char)
- (#error.Success (!inc end))
- (`` ("lux syntax char case!" char
- [[(~~ (static ..space))
- (~~ (static text.carriage-return))
- (~~ (static text.new-line))]
- (recur (!inc end))]
-
- ## else
- (ex.throw cannot-close-composite-expression closing-char))))))))
+(with-expansions [<cannot-close> (as-is (ex.throw cannot-close-composite-expression [closing-char source-code end]))]
+ (def: (read-close closing-char source-code//size source-code offset)
+ (-> Char Nat Text Offset (Error Offset))
+ (loop [end offset]
+ (<| (!with-char+ source-code//size source-code end char <cannot-close>
+ (if (!n/= closing-char char)
+ (#error.Success (!inc end))
+ (`` ("lux syntax char case!" char
+ [[(~~ (static ..space))
+ (~~ (static text.carriage-return))
+ (~~ (static text.new-line))]
+ (recur (!inc end))]
+
+ ## else
+ <cannot-close>))))))))
(`` (do-template [<name> <close> <tag> <context>]
[(def: (<name> parse source)
@@ -369,12 +376,13 @@
<output>))))))
(template: (!new-line where)
+ ## (-> Cursor Cursor)
(let [[where::file where::line where::column] where]
[where::file (!inc where::line) 0]))
-(with-expansions [<end> (ex.throw end-of-file current-module)
+(with-expansions [<end-of-file> (ex.throw end-of-file current-module)
<failure> (ex.throw unrecognized-input [where "General" source-code offset/0])
- <close!> (#error.Error (`` (~~ (static close-signal))))
+ <close!> (#error.Error close-signal)
<consume-1> (as-is [where (!inc offset/0) source-code])
<consume-2> (as-is [where (!inc/2 offset/0) source-code])]
@@ -392,10 +400,10 @@
(`` (def: (parse-short-name current-module [where offset/0 source-code])
(-> Text Source (Error [Source Name]))
- (<| (!with-char source-code offset/0 char/0 <end>)
+ (<| (!with-char source-code offset/0 char/0 <end-of-file>)
(if (!n/= (char (~~ (static ..name-separator))) char/0)
(let [offset/1 (!inc offset/0)]
- (<| (!with-char source-code offset/1 char/1 <end>)
+ (<| (!with-char source-code offset/1 char/1 <end-of-file>)
(!parse-half-name offset/1 char/1 current-module)))
(!parse-half-name offset/0 char/0 ..prelude)))))
@@ -439,6 +447,11 @@
[(~~ (static ..close-form))
(~~ (static ..close-tuple))
(~~ (static ..close-record))]))
+
+ ## TODO: Grammar macro for specifying syntax.
+ ## (grammar: lux-grammar
+ ## [expression ...]
+ ## [form "(" [#* expression] ")"])
(with-expansions [<parse> (as-is (parse current-module aliases source-code//size))
<horizontal-move> (as-is (recur [(update@ #.column inc where)
@@ -450,7 +463,7 @@
## This is to preserve the loop as much as possible and keep it tight.
(exec []
(function (recur [where offset/0 source-code])
- (<| (!with-char+ source-code//size source-code offset/0 char/0 <end>)
+ (<| (!with-char+ source-code//size source-code offset/0 char/0 <end-of-file>)
## The space was singled-out for special treatment
## because of how common it is.
(`` (if (!n/= (char (~~ (static ..space))) char/0)
@@ -483,7 +496,7 @@
## Special code
[(~~ (static ..sigil))]
(let [offset/1 (!inc offset/0)]
- (<| (!with-char+ source-code//size source-code offset/1 char/1 <end>)
+ (<| (!with-char+ source-code//size source-code offset/1 char/1 <end-of-file>)
("lux syntax char case!" char/1
[(~~ (do-template [<char> <bit>]
[[<char>]
@@ -502,7 +515,7 @@
(recur [(!new-line where) (!inc end) source-code])
_
- <end>)
+ <end-of-file>)
[(~~ (static ..name-separator))]
(!parse-short-name current-module <consume-2> where #.Tag)]
@@ -517,7 +530,7 @@
## Coincidentally (= name-separator frac-separator)
[(~~ (static ..name-separator))]
(let [offset/1 (!inc offset/0)]
- (<| (!with-char+ source-code//size source-code offset/1 char/1 <end>)
+ (<| (!with-char+ source-code//size source-code offset/1 char/1 <end-of-file>)
(if (!digit? char/1)
(let [offset/2 (!inc offset/1)]
(!parse-rev source-code//size offset/0 where offset/2 source-code))
@@ -525,7 +538,7 @@
[(~~ (static ..positive-sign))
(~~ (static ..negative-sign))]
- (!parse-signed source-code//size offset/0 where source-code <end>)
+ (!parse-signed source-code//size offset/0 where source-code <end-of-file>)
## Invalid characters at this point...
(~~ (<<closers>>))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-29 13:29:47 +0000