diff options
Diffstat (limited to '')
4 files changed, 89 insertions, 82 deletions
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>>)) |