diff options
Diffstat (limited to 'stdlib/source')
12 files changed, 147 insertions, 185 deletions
diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux index 73b018c95..9c7b7868d 100644 --- a/stdlib/source/lux/compiler/default.lux +++ b/stdlib/source/lux/compiler/default.lux @@ -54,8 +54,11 @@ (#error.Error error) (#error.Success [source' output]) - (#error.Success [[bundle (set@ #.source source' compiler)] - output])))) + (let [[cursor _] output] + (#error.Success [[bundle (|> compiler + (set@ #.source source') + (set@ #.cursor cursor))] + output]))))) ## ## (def: (write-module target-dir file-name module-name module artifacts) ## ## (-> File Text Text Module Artifacts (Process Any)) @@ -101,12 +104,7 @@ (<| (phase.timed (name-of ..module-compilation-iteration) "ITERATION") (do phase.Monad<Operation> [code (statement.lift-analysis - (do @ - [code (<| (phase.timed (name-of ..module-compilation-iteration) "syntax") - (..read reader)) - #let [[cursor _] code] - _ (analysis.set-cursor cursor)] - (wrap code))) + (..read reader)) _ (<| (phase.timed (name-of ..module-compilation-iteration) "PHASE") (totalS.phase code))] init.refresh))) diff --git a/stdlib/source/lux/compiler/default/name.lux b/stdlib/source/lux/compiler/default/name.lux index 925b0585d..184b2cab5 100644 --- a/stdlib/source/lux/compiler/default/name.lux +++ b/stdlib/source/lux/compiler/default/name.lux @@ -5,33 +5,32 @@ ["." text format]]]) -(def: (sanitize char) - (-> Nat Text) - (case char - (^ (char "*")) "_ASTER_" - (^ (char "+")) "_PLUS_" - (^ (char "-")) "_DASH_" - (^ (char "/")) "_SLASH_" - (^ (char "\")) "_BSLASH_" - (^ (char "_")) "_UNDERS_" - (^ (char "%")) "_PERCENT_" - (^ (char "$")) "_DOLLAR_" - (^ (char "'")) "_QUOTE_" - (^ (char "`")) "_BQUOTE_" - (^ (char "@")) "_AT_" - (^ (char "^")) "_CARET_" - (^ (char "&")) "_AMPERS_" - (^ (char "=")) "_EQ_" - (^ (char "!")) "_BANG_" - (^ (char "?")) "_QM_" - (^ (char ":")) "_COLON_" - (^ (char ".")) "_PERIOD_" - (^ (char ",")) "_COMMA_" - (^ (char "<")) "_LT_" - (^ (char ">")) "_GT_" - (^ (char "~")) "_TILDE_" - (^ (char "|")) "_PIPE_" - _ (text.from-code char))) +(`` (template: (!sanitize char) + ("lux syntax char case!" char + [["*"] "_ASTER_" + ["+"] "_PLUS_" + ["-"] "_DASH_" + ["/"] "_SLASH_" + ["\"] "_BSLASH_" + ["_"] "_UNDERS_" + ["%"] "_PERCENT_" + ["$"] "_DOLLAR_" + ["'"] "_QUOTE_" + ["`"] "_BQUOTE_" + ["@"] "_AT_" + ["^"] "_CARET_" + ["&"] "_AMPERS_" + ["="] "_EQ_" + ["!"] "_BANG_" + ["?"] "_QM_" + [":"] "_COLON_" + ["."] "_PERIOD_" + [","] "_COMMA_" + ["<"] "_LT_" + [">"] "_GT_" + ["~"] "_TILDE_" + ["|"] "_PIPE_"] + (text.from-code char)))) (def: #export (normalize name) (-> Text Text) @@ -40,7 +39,7 @@ output ""] (if (n/< name/size idx) (recur (inc idx) - (|> (text.nth idx name) maybe.assume sanitize (format output))) + (|> ("lux text char" name idx) !sanitize (format output))) output)))) (def: #export (definition [module short]) diff --git a/stdlib/source/lux/compiler/default/phase/analysis.lux b/stdlib/source/lux/compiler/default/phase/analysis.lux index 615075800..0a122bf3c 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis.lux @@ -183,12 +183,12 @@ (function (_ [bundle state]) (let [old-source (get@ #.source state)] (case (action [bundle (set@ #.source source state)]) - (#error.Error error) - (#error.Error error) - (#error.Success [[bundle' state'] output]) (#error.Success [[bundle' (set@ #.source old-source state')] - output]))))) + output]) + + (#error.Error error) + (#error.Error error))))) (def: fresh-bindings (All [k v] (Bindings k v)) @@ -208,12 +208,12 @@ (case (action [bundle (update@ #.scopes (|>> (#.Cons fresh-scope)) state)]) (#error.Success [[bundle' state'] output]) (case (get@ #.scopes state') - #.Nil - (#error.Error "Impossible error: Drained scopes!") - (#.Cons head tail) (#error.Success [[bundle' (set@ #.scopes tail state')] - [head output]])) + [head output]]) + + #.Nil + (#error.Error "Impossible error: Drained scopes!")) (#error.Error error) (#error.Error error)))) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/case.lux b/stdlib/source/lux/compiler/default/phase/analysis/case.lux index 2081ceb61..5044aed92 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/case.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/case.lux @@ -276,9 +276,6 @@ (def: #export (case analyse inputC branches) (-> Phase Code (List [Code Code]) (Operation Analysis)) (.case branches - #.Nil - (///.throw cannot-have-empty-branches "") - (#.Cons [patternH bodyH] branchesT) (do ///.Monad<Operation> [[inputT inputA] (//type.with-inference @@ -297,4 +294,7 @@ (#error.Error error) (///.fail error))] - (wrap (#//.Case inputA [outputH outputT]))))) + (wrap (#//.Case inputA [outputH outputT]))) + + #.Nil + (///.throw cannot-have-empty-branches ""))) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux b/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux index cf9abecd4..aff981e09 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux @@ -213,14 +213,6 @@ (def: #export (merge addition so-far) (-> Coverage Coverage (Error Coverage)) (case [addition so-far] - ## The addition cannot possibly improve the coverage. - [_ #Exhaustive] - (ex.throw redundant-pattern [so-far addition]) - - ## The addition completes the coverage. - [#Exhaustive _] - (error/wrap #Exhaustive) - [#Partial #Partial] (error/wrap #Partial) @@ -269,14 +261,6 @@ [(#Seq leftA rightA) (#Seq leftSF rightSF)] (case [(coverage/= leftSF leftA) (coverage/= rightSF rightA)] - ## There is nothing the addition adds to the coverage. - [#1 #1] - (ex.throw redundant-pattern [so-far addition]) - - ## The 2 sequences cannot possibly be merged. - [#0 #0] - (error/wrap (#Alt so-far addition)) - ## Same prefix [#1 #0] (do error.Monad<Error> @@ -292,7 +276,23 @@ [#0 #1] (do error.Monad<Error> [leftM (merge leftA leftSF)] - (wrap (#Seq leftM rightA)))) + (wrap (#Seq leftM rightA))) + + ## The 2 sequences cannot possibly be merged. + [#0 #0] + (error/wrap (#Alt so-far addition)) + + ## There is nothing the addition adds to the coverage. + [#1 #1] + (ex.throw redundant-pattern [so-far addition])) + + ## The addition cannot possibly improve the coverage. + [_ #Exhaustive] + (ex.throw redundant-pattern [so-far addition]) + + ## The addition completes the coverage. + [#Exhaustive _] + (error/wrap #Exhaustive) ## The left part will always match, so the addition is redundant. (^multi [(#Seq left right) single] diff --git a/stdlib/source/lux/compiler/default/phase/analysis/scope.lux b/stdlib/source/lux/compiler/default/phase/analysis/scope.lux index 2c34e7a44..2849e059d 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/scope.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/scope.lux @@ -1,7 +1,8 @@ (.module: [lux #* [control - monad] + monad + ["ex" exception (#+ exception:)]] [data [text ("text/." Equivalence<Text>) format] @@ -46,13 +47,13 @@ (loop [idx 0 mappings (get@ [#.captured #.mappings] scope)] (case mappings - #.Nil - #.None - (#.Cons [_name [_source-type _source-ref]] mappings') (if (text/= name _name) (#.Some [_source-type (#reference.Foreign idx)]) - (recur (inc idx) mappings'))))) + (recur (inc idx) mappings')) + + #.Nil + #.None))) (def: (reference? name scope) (-> Text Scope Bit) @@ -98,6 +99,12 @@ (#.Some [ref-type ref])])) ))))) +(exception: #export (cannot-create-local-binding-without-a-scope) + "") + +(exception: #export (invalid-scope-alteration) + "") + (def: #export (with-local [name type] action) (All [a] (-> [Text Type] (Operation a) (Operation a))) (function (_ [bundle state]) @@ -121,13 +128,13 @@ output])) _ - (error! "Invalid scope alteration.")) + (ex.throw invalid-scope-alteration [])) (#e.Error error) (#e.Error error))) _ - (#e.Error "Cannot create local binding without a scope.")) + (ex.throw cannot-create-local-binding-without-a-scope [])) )) (do-template [<name> <val-type>] @@ -159,27 +166,29 @@ (case (action [bundle (update@ #.scopes (|>> (#.Cons (scope parent-name name))) state)]) - (#e.Error error) - (#e.Error error) - (#e.Success [[bundle' state'] output]) (#e.Success [[bundle' (update@ #.scopes (|>> list.tail (maybe.default (list))) state')] output]) - )) + + (#e.Error error) + (#e.Error error))) )) +(exception: #export (cannot-get-next-reference-when-there-is-no-scope) + "") + (def: #export next-local (Operation Register) (extension.lift (function (_ state) (case (get@ #.scopes state) - #.Nil - (#e.Error "Cannot get next reference when there is no scope.") - (#.Cons top _) - (#e.Success [state (get@ [#.locals #.counter] top)]))))) + (#e.Success [state (get@ [#.locals #.counter] top)]) + + #.Nil + (ex.throw cannot-get-next-reference-when-there-is-no-scope []))))) (def: (ref-to-variable ref) (-> Ref Variable) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/structure.lux b/stdlib/source/lux/compiler/default/phase/analysis/structure.lux index 3988349e0..43cb8e0d2 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/structure.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/structure.lux @@ -148,12 +148,12 @@ _ (case (type.apply (list inputT) funT) - #.None - (///.throw not-a-quantified-type funT) - (#.Some outputT) (//type.with-type outputT - (sum analyse tag valueC)))) + (sum analyse tag valueC)) + + #.None + (///.throw not-a-quantified-type funT))) _ (///.throw invalid-variant-type [expectedT tag valueC]))))) @@ -241,12 +241,12 @@ _ (case (type.apply (list inputT) funT) - #.None - (///.throw not-a-quantified-type funT) - (#.Some outputT) (//type.with-type outputT - (product analyse membersC)))) + (product analyse membersC)) + + #.None + (///.throw not-a-quantified-type funT))) _ (///.throw invalid-tuple-type [expectedT membersC]) @@ -317,13 +317,13 @@ (do @ [key (extension.lift (macro.normalize key))] (case (dict.get key tag->idx) - #.None - (///.throw tag-does-not-belong-to-record [key recordT]) - (#.Some idx) (if (dict.contains? idx idx->val) (///.throw cannot-repeat-tag [key record]) - (wrap (dict.put idx val idx->val)))))) + (wrap (dict.put idx val idx->val))) + + #.None + (///.throw tag-does-not-belong-to-record [key recordT])))) (: (Dictionary Nat Code) (dict.new number.Hash<Nat>)) record) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/type.lux b/stdlib/source/lux/compiler/default/phase/analysis/type.lux index 3eb574986..36fee29f8 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/type.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/type.lux @@ -21,12 +21,12 @@ (All [a] (-> (tc.Check a) (Operation a))) (function (_ (^@ stateE [bundle state])) (case (action (get@ #.type-context state)) - (#error.Error error) - ((///.fail error) stateE) - (#error.Success [context' output]) (#error.Success [[bundle (set@ #.type-context context' state)] - output])))) + output]) + + (#error.Error error) + ((///.fail error) stateE)))) (def: #export with-fresh-env (All [a] (-> (Operation a) (Operation a))) diff --git a/stdlib/source/lux/compiler/default/phase/extension.lux b/stdlib/source/lux/compiler/default/phase/extension.lux index c87d8d54c..f5baf2a5b 100644 --- a/stdlib/source/lux/compiler/default/phase/extension.lux +++ b/stdlib/source/lux/compiler/default/phase/extension.lux @@ -61,23 +61,26 @@ (All [s i o] (-> Text (Handler s i o) (Operation s i o Any))) (function (_ [bundle state]) - (if (dictionary.contains? name bundle) - (ex.throw cannot-overwrite name) + (case (dictionary.get name bundle) + #.None (#error.Success [[(dictionary.put name handler bundle) state] - []])))) + []]) + + _ + (ex.throw cannot-overwrite name)))) (def: #export (apply where phase [name parameters]) (All [s i o] (-> Text (Phase s i o) (Extension i) (Operation s i o o))) (function (_ (^@ stateE [bundle state])) (case (dictionary.get name bundle) - #.None - (ex.throw unknown [where name bundle]) - (#.Some handler) ((<| (//.timed (name-of ..apply) (%t name)) ((handler name phase) parameters)) - stateE)))) + stateE) + + #.None + (ex.throw unknown [where name bundle])))) (def: #export (localized get set transform) (All [s s' i o v] @@ -87,11 +90,11 @@ (function (_ [bundle state]) (let [old (get state)] (case (operation [bundle (set (transform old) state)]) - (#error.Error error) - (#error.Error error) - (#error.Success [[bundle' state'] output]) - (#error.Success [[bundle' (set old state')] output])))))) + (#error.Success [[bundle' (set old state')] output]) + + (#error.Error error) + (#error.Error error)))))) (def: #export (temporary transform) (All [s i o v] @@ -100,11 +103,11 @@ (function (_ operation) (function (_ [bundle state]) (case (operation [bundle (transform state)]) - (#error.Error error) - (#error.Error error) - (#error.Success [[bundle' state'] output]) - (#error.Success [[bundle' state] output]))))) + (#error.Success [[bundle' state] output]) + + (#error.Error error) + (#error.Error error))))) (def: #export (with-state state) (All [s i o v] @@ -129,8 +132,8 @@ (//.Operation [(Bundle s i o) s] v))) (function (_ [bundle state]) (case (action state) - (#error.Error error) - (#error.Error error) - (#error.Success [state' output]) - (#error.Success [[bundle state'] output])))) + (#error.Success [[bundle state'] output]) + + (#error.Error error) + (#error.Error error)))) diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux index 64edb791b..5fac5b1d0 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux @@ -1064,12 +1064,12 @@ ## else (wrap #Fail)))))))] (case (list.search-all pass! candidates) - #.Nil - (////.throw no-candidates [class-name method-name (list.search-all hint! candidates)]) - (#.Cons method #.Nil) (wrap method) + #.Nil + (////.throw no-candidates [class-name method-name (list.search-all hint! candidates)]) + candidates (////.throw too-many-candidates [class-name method-name candidates])))) @@ -1124,12 +1124,12 @@ (if passes? (|>> #Pass) (|>> #Hint)) (constructor-signature constructor))))))] (case (list.search-all pass! candidates) - #.Nil - (////.throw no-candidates [class-name ..constructor-method (list.search-all hint! candidates)]) - (#.Cons constructor #.Nil) (wrap constructor) + #.Nil + (////.throw no-candidates [class-name ..constructor-method (list.search-all hint! candidates)]) + candidates (////.throw too-many-candidates [class-name ..constructor-method candidates])))) diff --git a/stdlib/source/lux/compiler/default/phase/translation.lux b/stdlib/source/lux/compiler/default/phase/translation.lux index b1a224e80..8565cefcc 100644 --- a/stdlib/source/lux/compiler/default/phase/translation.lux +++ b/stdlib/source/lux/compiler/default/phase/translation.lux @@ -177,11 +177,11 @@ (-> Text <inputT> (Operation anchor expression statement Any))) (function (_ (^@ state+ [bundle state])) (case (:: (get@ #host state) <name> label code) - (#error.Error error) - (ex.throw cannot-interpret error) - (#error.Success output) - (#error.Success [state+ output]))))] + (#error.Success [state+ output]) + + (#error.Error error) + (ex.throw cannot-interpret error))))] [evaluate! expression] [execute! statement] @@ -192,11 +192,11 @@ (-> Name expression (Operation anchor expression statement [Text Any]))) (function (_ (^@ stateE [bundle state])) (case (:: (get@ #host state) define! name code) - (#error.Error error) - (ex.throw cannot-interpret error) - (#error.Success output) - (#error.Success [stateE output])))) + (#error.Success [stateE output]) + + (#error.Error error) + (ex.throw cannot-interpret error)))) (def: #export (save! name code) (All [anchor expression statement] @@ -239,12 +239,12 @@ (function (_ [bundle state]) (let [cache (get@ #name-cache state)] (case (dictionary.get lux-name cache) - (#.Some old-host-name) - (ex.throw cannot-overwrite-lux-name [lux-name old-host-name host-name]) - #.None (#error.Success [[bundle (update@ #name-cache (dictionary.put lux-name host-name) state)] - []]))))) + []]) + + (#.Some old-host-name) + (ex.throw cannot-overwrite-lux-name [lux-name old-host-name host-name]))))) diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index 52ac38720..5ada2ad23 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -25,16 +25,15 @@ ## [file-name, line, column] to keep track of their provenance and ## location, which is helpful for documentation and debugging. (.module: - [lux (#- int rev) + [lux #* [control monad - ["p" parser ("parser/." Monad<Parser>)] ["ex" exception (#+ exception:)]] [data ["." error (#+ Error)] ["." number] ["." text - ["l" lexer (#+ Offset Lexer)] + [lexer (#+ Offset)] format] [collection ["." list] @@ -82,9 +81,6 @@ [!n/- "lux i64 -"] ) -(type: #export Syntax - (-> Cursor (Lexer [Cursor Code]))) - (type: #export Aliases (Dictionary Text Text)) (def: #export no-aliases Aliases (dictionary.new text.Hash<Text>)) @@ -121,42 +117,6 @@ ## encoded on the parser. (def: #export name-separator ".") -## These are very simple parsers that just cut chunks of text in -## specific shapes and then use decoders already present in the -## standard library to actually produce the values from the literals. -(def: rich-digit - (Lexer Text) - (p.either l.decimal - (p.after (l.this "_") (parser/wrap "")))) - -(def: rich-digits^ - (Lexer Text) - (l.and l.decimal - (l.some rich-digit))) - -(def: sign^ (l.one-of "+-")) - -(def: #export (frac where) - Syntax - (do p.Monad<Parser> - [chunk ($_ l.and - sign^ - rich-digits^ - (l.one-of ".") - rich-digits^ - (p.default "" - ($_ l.and - (l.one-of "eE") - sign^ - rich-digits^)))] - (case (:: number.Codec<Text,Frac> decode chunk) - (#.Left error) - (p.fail error) - - (#.Right value) - (wrap [(update@ #.column (n/+ (text.size chunk)) where) - [where (#.Frac value)]])))) - (exception: #export (end-of-file {module Text}) (ex.report ["Module" (%t module)])) @@ -179,13 +139,6 @@ (exception: #export (cannot-close-composite-expression {closing-char Char}) (ex.report ["Closing Character" (text.from-code closing-char)])) -(def: (ast current-module aliases) - (-> Text Aliases Syntax) - (function (ast' where) - ($_ p.either - (..frac where) - ))) - (type: Parser (-> Source (Error [Source Code]))) @@ -272,11 +225,11 @@ (template: (!guarantee-no-new-lines content body) (case ("lux text index" content (static text.new-line) 0) - (#.Some g!_) - (ex.throw ..text-cannot-contain-new-lines content) + #.None + body g!_ - body)) + (ex.throw ..text-cannot-contain-new-lines content))) (template: (!read-text where offset source-code) (case ("lux text index" source-code (static ..text-delimiter) offset) |