diff options
52 files changed, 804 insertions, 800 deletions
@@ -103,7 +103,7 @@ The **(Lux a)** type is the one responsible for the magic by threading **Compile You can use **macro:** to define these monadic macros. -Alternatively, you can use the **syntax:** macro, which also offers monadic parsing of AST tokens for convenience. +Alternatively, you can use the **syntax:** macro, which also offers monadic parsing of Code tokens for convenience. ### Custom pattern-matching diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj index 6ce50c06f..87d6786e5 100644 --- a/luxc/src/lux/base.clj +++ b/luxc/src/lux/base.clj @@ -69,7 +69,7 @@ ("Left" 1) ("Right" 1)) -;; AST +;; Code (defvariant ("Bool" 1) ("Nat" 1) diff --git a/new-luxc/source/luxc/analyser/lux.lux b/new-luxc/source/luxc/analyser/lux.lux index 86f9839dc..f0e9a3538 100644 --- a/new-luxc/source/luxc/analyser/lux.lux +++ b/new-luxc/source/luxc/analyser/lux.lux @@ -94,7 +94,7 @@ (analyse-definition cursor reference))) (def: #export (analyse-check analyse eval cursor type value) - (-> Analyser Eval Cursor AST AST (Lux Analysis)) + (-> Analyser Eval Cursor Code Code (Lux Analysis)) (do Monad<Lux> [actual (eval Type type) #let [actual (:! Type actual)] @@ -105,7 +105,7 @@ (analyse eval value)))) (def: #export (analyse-coerce analyse eval cursor type value) - (-> Analyser Eval Cursor AST AST (Lux Analysis)) + (-> Analyser Eval Cursor Code Code (Lux Analysis)) (do Monad<Lux> [actual (eval Type type) #let [actual (:! Type actual)] @@ -117,8 +117,8 @@ (wrap (&common;replace-type actual =value)))) (def: (analyse-typed-tuple analyse cursor members) - (-> (-> AST (Lux Analysis)) Cursor - (List AST) + (-> (-> Code (Lux Analysis)) Cursor + (List Code) (Lux Analysis)) (do Monad<Lux> [expected macro;expected-type] @@ -174,8 +174,8 @@ (#lang;Structure (#lang;Tuple members))])) (def: #export (analyse-tuple analyse cursor members) - (-> (-> AST (Lux Analysis)) Cursor - (List AST) + (-> (-> Code (Lux Analysis)) Cursor + (List Code) (Lux Analysis)) (do Monad<Lux> [expected macro;expected-type] @@ -218,8 +218,8 @@ ))) (def: #export (analyse-variant analyse cursor tag value) - (-> (-> AST (Lux Analysis)) Cursor - Nat AST + (-> (-> Code (Lux Analysis)) Cursor + Nat Code (Lux Analysis)) (do Monad<Lux> [expected macro;expected-type] diff --git a/new-luxc/source/luxc/compiler.lux b/new-luxc/source/luxc/compiler.lux index 67a9928fd..8d0ea8a2f 100644 --- a/new-luxc/source/luxc/compiler.lux +++ b/new-luxc/source/luxc/compiler.lux @@ -15,7 +15,7 @@ )) (def: (compile ast) - (-> AST (Lux Unit)) + (-> Code (Lux Unit)) (case ast (^ [_ (#;Form (list [_ (#;Symbol ["" "_lux_def"])] [_ (#;Symbol ["" def-name])] @@ -61,7 +61,7 @@ (wrap output))) (def: parse - (Lux AST) + (Lux Code) (function [compiler] (case (&parser;parse (get@ #;source compiler)) (#E;Error error) diff --git a/new-luxc/source/luxc/compiler/expr.jvm.lux b/new-luxc/source/luxc/compiler/expr.jvm.lux index 138d0d540..f0508c0d2 100644 --- a/new-luxc/source/luxc/compiler/expr.jvm.lux +++ b/new-luxc/source/luxc/compiler/expr.jvm.lux @@ -23,7 +23,7 @@ (undefined)) (def: #export (compile input) - (-> AST (Lux Compiled)) + (-> Code (Lux Compiled)) (|> input (&analyser;analyse eval) (Lux/map &synthesizer;synthesize) diff --git a/new-luxc/source/luxc/compiler/statement.jvm.lux b/new-luxc/source/luxc/compiler/statement.jvm.lux index 0e53ba37d..7e48d061f 100644 --- a/new-luxc/source/luxc/compiler/statement.jvm.lux +++ b/new-luxc/source/luxc/compiler/statement.jvm.lux @@ -12,14 +12,14 @@ (compiler ["&;" expr]))) (def: #export (compile-def def-name def-value def-meta) - (-> Text AST AST (Lux Unit)) + (-> Text Code Code (Lux Unit)) (do Monad<Lux> [=def-value (&expr;compile def-value) =def-meta (&expr;compile def-meta)] (undefined))) (def: #export (compile-program prog-args prog-body) - (-> Text AST (Lux Unit)) + (-> Text Code (Lux Unit)) (do Monad<Lux> [=prog-body (&env;with-local [prog-args (type (List Text))] (&expr;compile prog-body))] diff --git a/new-luxc/source/luxc/lang.lux b/new-luxc/source/luxc/lang.lux index 0c5c97192..787895466 100644 --- a/new-luxc/source/luxc/lang.lux +++ b/new-luxc/source/luxc/lang.lux @@ -38,7 +38,7 @@ Unit) (type: #export Eval - (-> Type AST (Lux Top))) + (-> Type Code (Lux Top))) (type: #export Analyser - (-> Eval AST (Lux Analysis))) + (-> Eval Code (Lux Analysis))) diff --git a/new-luxc/source/luxc/parser.lux b/new-luxc/source/luxc/parser.lux index 0115d1924..c9ba89b75 100644 --- a/new-luxc/source/luxc/parser.lux +++ b/new-luxc/source/luxc/parser.lux @@ -1,7 +1,7 @@ ## This is the LuxC's parser. ## It takes the source code of a Lux file in raw text form and ## extracts the syntactic structure of the code from it. -## It only produces Lux AST nodes, and thus removes any white-space +## It only produces Lux Code nodes, and thus removes any white-space ## and comments while processing its inputs. ## Another important aspect of the parser is that it keeps track of @@ -21,7 +21,7 @@ ## They are supposed to produce some parsed output, alongside an ## updated cursor pointing to the end position, after the parser was run. -## Lux AST nodes/tokens are annotated with cursor meta-data +## Lux Code nodes/tokens are annotated with cursor meta-data ## (file-name, line, column) to keep track of their provenance and ## location, which is helpful for documentation and debugging. @@ -139,7 +139,7 @@ (l;either (single-line-comment^ where) (multi-line-comment^ where))) -## To simplify parsing, I remove any left-padding that an AST token +## To simplify parsing, I remove any left-padding that an Code token ## may have prior to parsing the token itself. ## Left-padding is assumed to be either white-space or a comment. ## The cursor gets updated, but the padding gets ignored. @@ -208,7 +208,7 @@ ## standard library to actually produce the values from the literals. (do-template [<name> <tag> <lexer> <codec>] [(def: #export (<name> where) - (-> Cursor (Lexer [Cursor AST])) + (-> Cursor (Lexer [Cursor Code])) (do Monad<Lexer> [chunk <lexer>] (case (:: <codec> decode chunk) @@ -249,7 +249,7 @@ ## This parser doesn't delegate the work of producing the value to a ## codec, since the raw-char^ parser already takes care of that magic. (def: #export (parse-char where) - (-> Cursor (Lexer [Cursor AST])) + (-> Cursor (Lexer [Cursor Code])) (do Monad<Lexer> [[chunk value] (l;enclosed ["#\"" "\""] raw-char^)] @@ -259,7 +259,7 @@ ## This parser looks so complex because text in Lux can be multi-line ## and there are rules regarding how this is handled. (def: #export (parse-text where) - (-> Cursor (Lexer [Cursor AST])) + (-> Cursor (Lexer [Cursor Code])) (do Monad<Lexer> [## Lux text "is delimited by double-quotes", as usual in most ## programming languages. @@ -346,15 +346,15 @@ ## Form and tuple syntax is mostly the same, differing only in the ## delimiters involved. -## They may have an arbitrary number of arbitrary AST nodes as elements. +## They may have an arbitrary number of arbitrary Code nodes as elements. (do-template [<name> <tag> <open> <close>] [(def: (<name> where parse-ast) (-> Cursor - (-> Cursor (Lexer [Cursor AST])) - (Lexer [Cursor AST])) + (-> Cursor (Lexer [Cursor Code])) + (Lexer [Cursor Code])) (do Monad<Lexer> [_ (l;text <open>) - [where' elems] (loop [elems (: (V;Vector AST) + [where' elems] (loop [elems (: (V;Vector Code) V;empty) where where] (l;either (do @ @@ -384,16 +384,16 @@ ## Semantically, though, records and tuples are just 2 different ## representations for the same thing (a tuple). ## In normal Lux syntax, the key position in the pair will be a tag -## AST node, however, record AST nodes allow any AST node to occupy -## this position, since it may be useful when processing AST syntax in +## Code node, however, record Code nodes allow any Code node to occupy +## this position, since it may be useful when processing Code syntax in ## macros. (def: (parse-record where parse-ast) (-> Cursor - (-> Cursor (Lexer [Cursor AST])) - (Lexer [Cursor AST])) + (-> Cursor (Lexer [Cursor Code])) + (Lexer [Cursor Code])) (do Monad<Lexer> [_ (l;text "{") - [where' elems] (loop [elems (: (V;Vector [AST AST]) + [where' elems] (loop [elems (: (V;Vector [Code Code]) V;empty) where where] (l;either (do @ @@ -428,7 +428,7 @@ ## possible). ## In particular, no white-space can be used, and neither can other ## characters which are already used by Lux as delimiters for other -## AST nodes (thereby reducing ambiguity while parsing). +## Code nodes (thereby reducing ambiguity while parsing). ## Additionally, the first character in an identifier's part cannot be ## a digit, to avoid confusion with regards to numbers. (def: ident-part^ @@ -498,7 +498,7 @@ ## construction and de-structuring (during pattern-matching). (do-template [<name> <tag> <lexer> <extra>] [(def: #export (<name> where) - (-> Cursor (Lexer [Cursor AST])) + (-> Cursor (Lexer [Cursor Code])) (do Monad<Lexer> [[value length] <lexer>] (wrap [(update@ #;column (|>. ($_ n.+ <extra> length)) where) @@ -509,7 +509,7 @@ ) (def: (parse-ast where) - (-> Cursor (Lexer [Cursor AST])) + (-> Cursor (Lexer [Cursor Code])) (do Monad<Lexer> [where (left-padding^ where)] ($_ l;either @@ -528,7 +528,7 @@ ))) (def: #export (parse [where code]) - (-> [Cursor Text] (Error [[Cursor Text] AST])) + (-> [Cursor Text] (Error [[Cursor Text] Code])) (case (l;run' code (parse-ast where)) (#E;Error error) (#E;Error error) diff --git a/new-luxc/test/test/luxc/parser.lux b/new-luxc/test/test/luxc/parser.lux index 9f8584b2c..5218bb926 100644 --- a/new-luxc/test/test/luxc/parser.lux +++ b/new-luxc/test/test/luxc/parser.lux @@ -10,7 +10,7 @@ ["E" error] (coll [list])) ["R" math/random "R/" Monad<Random>] - (macro [ast]) + (macro [code]) test) (luxc ["&" parser])) @@ -39,15 +39,15 @@ (R;seq ident-part^ ident-part^)) (def: ast^ - (R;Random AST) - (let [numeric^ (: (R;Random AST) + (R;Random Code) + (let [numeric^ (: (R;Random Code) ($_ R;either (|> R;bool (R/map (|>. #;Bool [default-cursor]))) (|> R;nat (R/map (|>. #;Nat [default-cursor]))) (|> R;int (R/map (|>. #;Int [default-cursor]))) (|> R;deg (R/map (|>. #;Deg [default-cursor]))) (|> R;real (R/map (|>. #;Real [default-cursor]))))) - textual^ (: (R;Random AST) + textual^ (: (R;Random Code) ($_ R;either (|> R;char (R/map (|>. #;Char [default-cursor]))) (do R;Monad<Random> @@ -55,7 +55,7 @@ (|> (R;text size) (R/map (|>. #;Text [default-cursor])))) (|> ident^ (R/map (|>. #;Symbol [default-cursor]))) (|> ident^ (R/map (|>. #;Tag [default-cursor]))))) - simple^ (: (R;Random AST) + simple^ (: (R;Random Code) ($_ R;either numeric^ textual^))] @@ -64,7 +64,7 @@ (let [multi^ (do R;Monad<Random> [size (|> R;nat (R/map (n.% +3)))] (R;list size ast^)) - composite^ (: (R;Random AST) + composite^ (: (R;Random Code) ($_ R;either (|> multi^ (R/map (|>. #;Form [default-cursor]))) (|> multi^ (R/map (|>. #;Tuple [default-cursor]))) @@ -78,12 +78,12 @@ (test: "Lux code parser." [sample ast^] (assert "Can parse Lux code." - (case (&;parse [default-cursor (ast;to-text sample)]) + (case (&;parse [default-cursor (code;to-text sample)]) (#E;Error error) false (#E;Success [_ parsed]) - (:: ast;Eq<AST> = parsed sample)) + (:: code;Eq<Code> = parsed sample)) )) (def: comment-text^ @@ -148,21 +148,21 @@ false (#E;Success [_ parsed]) - (:: ast;Eq<AST> = + (:: code;Eq<Code> = parsed - (ast;text good-output))))) + (code;text good-output))))) (assert "Can handle comments." (case (&;parse [default-cursor - (format comment (ast;to-text sample))]) + (format comment (code;to-text sample))]) (#E;Error error) false (#E;Success [_ parsed]) - (:: ast;Eq<AST> = parsed sample))) + (:: code;Eq<Code> = parsed sample))) (assert "Will reject unbalanced multi-line comments." (and (case (&;parse [default-cursor (format "#(" "#(" unbalanced-comment ")#" - (ast;to-text sample))]) + (code;to-text sample))]) (#E;Error error) true @@ -170,7 +170,7 @@ false) (case (&;parse [default-cursor (format "#(" unbalanced-comment ")#" ")#" - (ast;to-text sample))]) + (code;to-text sample))]) (#E;Error error) true diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index af5a0d142..ed2d81667 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -332,7 +332,7 @@ (#Cons (#TextA "line") (#Cons (#TextA "column") #Nil))))] - (#Cons [["lux" "doc"] (#TextA "Cursors are for specifying the location of AST nodes in Lux files during compilation.")] + (#Cons [["lux" "doc"] (#TextA "Cursors are for specifying the location of Code nodes in Lux files during compilation.")] default-def-meta-exported))) ## (type: (Meta m v) @@ -387,7 +387,7 @@ #Nil)))))] default-def-meta-exported)) -## (type: (AST' w) +## (type: (Code' w) ## (#Bool Bool) ## (#Nat Nat) ## (#Int Int) @@ -397,17 +397,17 @@ ## (#Text Text) ## (#Symbol Text Text) ## (#Tag Text Text) -## (#Form (List (w (AST' w)))) -## (#Tuple (List (w (AST' w)))) -## (#Record (List [(w (AST' w)) (w (AST' w))]))) -(_lux_def AST' - (#Named ["lux" "AST'"] +## (#Form (List (w (Code' w)))) +## (#Tuple (List (w (Code' w)))) +## (#Record (List [(w (Code' w)) (w (Code' w))]))) +(_lux_def Code' + (#Named ["lux" "Code'"] (_lux_case (#App (#Bound +1) (#App (#Bound +0) (#Bound +1))) - AST - (_lux_case (#App [List AST]) - AST-List + Code + (_lux_case (#App [List Code]) + Code-List (#UnivQ #Nil (#Sum ## "lux;Bool" Bool @@ -428,11 +428,11 @@ (#Sum ## "lux;Tag" Ident (#Sum ## "lux;Form" - AST-List + Code-List (#Sum ## "lux;Tuple" - AST-List + Code-List ## "lux;Record" - (#App List (#Product AST AST)) + (#App List (#Product Code Code)) ))))))))))) )))) (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Bool") @@ -451,18 +451,18 @@ (#Cons [["lux" "type-args"] (#ListA (#Cons (#TextA "w") #;Nil))] default-def-meta-exported))) -## (type: AST -## (Meta Cursor (AST' (Meta Cursor)))) -(_lux_def AST - (#Named ["lux" "AST"] +## (type: Code +## (Meta Cursor (Code' (Meta Cursor)))) +(_lux_def Code + (#Named ["lux" "Code"] (_lux_case (#App Meta Cursor) w - (#App w (#App AST' w)))) - (#Cons [["lux" "doc"] (#TextA "The type of AST nodes for Lux syntax.")] + (#App w (#App Code' w)))) + (#Cons [["lux" "doc"] (#TextA "The type of Code nodes for Lux syntax.")] default-def-meta-exported)) -(_lux_def AST-List - (#App List AST) +(_lux_def Code-List + (#App List Code) default-def-meta-unexported) ## (type: (Either l r) @@ -680,10 +680,10 @@ default-def-meta-exported))) ## (type: Macro -## (-> (List AST) (Lux (List AST)))) +## (-> (List Code) (Lux (List Code)))) (_lux_def Macro (#Named ["lux" "Macro"] - (#Function AST-List (#App Lux AST-List))) + (#Function Code-List (#App Lux Code-List))) (#Cons [["lux" "doc"] (#TextA "Functions that run at compile-time and allow you to transform and extend the language in powerful ways.")] default-def-meta-exported)) @@ -693,9 +693,9 @@ #Nil) (_lux_def _meta - (_lux_: (#Function (#App AST' + (_lux_: (#Function (#App Code' (#App Meta Cursor)) - AST) + Code) (_lux_function _ data [_cursor data])) #Nil) @@ -725,62 +725,62 @@ #Nil) (_lux_def bool$ - (_lux_: (#Function Bool AST) + (_lux_: (#Function Bool Code) (_lux_function _ value (_meta (#Bool value)))) #Nil) (_lux_def nat$ - (_lux_: (#Function Nat AST) + (_lux_: (#Function Nat Code) (_lux_function _ value (_meta (#Nat value)))) #Nil) (_lux_def int$ - (_lux_: (#Function Int AST) + (_lux_: (#Function Int Code) (_lux_function _ value (_meta (#Int value)))) #Nil) (_lux_def deg$ - (_lux_: (#Function Deg AST) + (_lux_: (#Function Deg Code) (_lux_function _ value (_meta (#Deg value)))) #Nil) (_lux_def real$ - (_lux_: (#Function Real AST) + (_lux_: (#Function Real Code) (_lux_function _ value (_meta (#Real value)))) #Nil) (_lux_def char$ - (_lux_: (#Function Char AST) + (_lux_: (#Function Char Code) (_lux_function _ value (_meta (#Char value)))) #Nil) (_lux_def text$ - (_lux_: (#Function Text AST) + (_lux_: (#Function Text Code) (_lux_function _ text (_meta (#Text text)))) #Nil) (_lux_def symbol$ - (_lux_: (#Function Ident AST) + (_lux_: (#Function Ident Code) (_lux_function _ ident (_meta (#Symbol ident)))) #Nil) (_lux_def tag$ - (_lux_: (#Function Ident AST) + (_lux_: (#Function Ident Code) (_lux_function _ ident (_meta (#Tag ident)))) #Nil) (_lux_def form$ - (_lux_: (#Function (#App List AST) AST) + (_lux_: (#Function (#App List Code) Code) (_lux_function _ tokens (_meta (#Form tokens)))) #Nil) (_lux_def tuple$ - (_lux_: (#Function (#App List AST) AST) + (_lux_: (#Function (#App List Code) Code) (_lux_function _ tokens (_meta (#Tuple tokens)))) #Nil) (_lux_def record$ - (_lux_: (#Function (#App List (#Product AST AST)) AST) + (_lux_: (#Function (#App List (#Product Code Code)) Code) (_lux_function _ tokens (_meta (#Record tokens)))) #Nil) @@ -842,7 +842,7 @@ default-macro-meta) (_lux_def export?-meta - (_lux_: AST + (_lux_: Code (tuple$ (#Cons [(tuple$ (#Cons [(text$ "lux") (#Cons [(text$ "export?") #Nil])])) (#Cons [(form$ (#Cons [(tag$ ["lux" "BoolA"]) (#Cons [(bool$ true) @@ -851,7 +851,7 @@ #Nil) (_lux_def hidden?-meta - (_lux_: AST + (_lux_: Code (tuple$ (#Cons [(tuple$ (#Cons [(text$ "lux") (#Cons [(text$ "hidden?") #Nil])])) (#Cons [(form$ (#Cons [(tag$ ["lux" "BoolA"]) (#Cons [(bool$ true) @@ -860,7 +860,7 @@ #Nil) (_lux_def macro?-meta - (_lux_: AST + (_lux_: Code (tuple$ (#Cons [(tuple$ (#Cons [(text$ "lux") (#Cons [(text$ "macro?") #Nil])])) (#Cons [(form$ (#Cons [(tag$ ["lux" "BoolA"]) (#Cons [(bool$ true) @@ -869,7 +869,7 @@ #Nil) (_lux_def with-export-meta - (_lux_: (#Function AST AST) + (_lux_: (#Function Code Code) (function'' [tail] (form$ (#Cons (tag$ ["lux" "Cons"]) (#Cons export?-meta @@ -877,7 +877,7 @@ #Nil) (_lux_def with-hidden-meta - (_lux_: (#Function AST AST) + (_lux_: (#Function Code Code) (function'' [tail] (form$ (#Cons (tag$ ["lux" "Cons"]) (#Cons hidden?-meta @@ -885,7 +885,7 @@ #Nil) (_lux_def with-macro-meta - (_lux_: (#Function AST AST) + (_lux_: (#Function Code Code) (function'' [tail] (form$ (#Cons (tag$ ["lux" "Cons"]) (#Cons macro?-meta @@ -1028,11 +1028,11 @@ (def:'' RepEnv #Nil Type - ($' List (#Product Text AST))) + ($' List (#Product Text Code))) (def:'' (make-env xs ys) #Nil - (#Function ($' List Text) (#Function ($' List AST) RepEnv)) + (#Function ($' List Text) (#Function ($' List Code) RepEnv)) (_lux_case [xs ys] [(#Cons x xs') (#Cons y ys')] (#Cons [x y] (make-env xs' ys')) @@ -1047,7 +1047,7 @@ (def:'' (get-rep key env) #Nil - (#Function Text (#Function RepEnv ($' Maybe AST))) + (#Function Text (#Function RepEnv ($' Maybe Code))) (_lux_case env #Nil #None @@ -1062,7 +1062,7 @@ (def:'' (replace-syntax reps syntax) #Nil - (#Function RepEnv (#Function AST AST)) + (#Function RepEnv (#Function Code Code)) (_lux_case syntax [_ (#Symbol "" name)] (_lux_case (get-rep name reps) @@ -1079,7 +1079,7 @@ [meta (#Tuple (map (replace-syntax reps) members))] [meta (#Record slots)] - [meta (#Record (map (_lux_: (#Function (#Product AST AST) (#Product AST AST)) + [meta (#Record (map (_lux_: (#Function (#Product Code Code) (#Product Code Code)) (function'' [slot] (_lux_case slot [k v] @@ -1092,13 +1092,13 @@ (def:'' (update-bounds ast) #Nil - (#Function AST AST) + (#Function Code Code) (_lux_case ast [_ (#Tuple members)] (tuple$ (map update-bounds members)) [_ (#Record pairs)] - (record$ (map (_lux_: (#Function (#Product AST AST) (#Product AST AST)) + (record$ (map (_lux_: (#Function (#Product Code Code) (#Product Code Code)) (function'' [pair] (let'' [name val] pair [name (update-bounds val)]))) @@ -1115,10 +1115,10 @@ (def:'' (parse-quantified-args args next) #Nil - ## (-> (List AST) (-> (List Text) (Lux (List AST))) (Lux (List AST))) - (#Function ($' List AST) - (#Function (#Function ($' List Text) (#App Lux ($' List AST))) - (#App Lux ($' List AST)) + ## (-> (List Code) (-> (List Text) (Lux (List Code))) (Lux (List Code))) + (#Function ($' List Code) + (#Function (#Function ($' List Text) (#App Lux ($' List Code))) + (#App Lux ($' List Code)) )) (_lux_case args #Nil @@ -1133,7 +1133,7 @@ (def:'' (make-bound idx) #Nil - (#Function Nat AST) + (#Function Nat Code) (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ idx) #Nil)))) (def:'' (fold f init xs) @@ -1178,7 +1178,7 @@ (#Cons [_ (#Tuple args)] (#Cons body #Nil)) (parse-quantified-args args (function'' [names] - (let'' body' (fold (_lux_: (#Function Text (#Function AST AST)) + (let'' body' (fold (_lux_: (#Function Text (#Function Code Code)) (function'' [name' body'] (form$ (#Cons (tag$ ["lux" "UnivQ"]) (#Cons (tag$ ["lux" "Nil"]) @@ -1229,7 +1229,7 @@ (#Cons [_ (#Tuple args)] (#Cons body #Nil)) (parse-quantified-args args (function'' [names] - (let'' body' (fold (_lux_: (#Function Text (#Function AST AST)) + (let'' body' (fold (_lux_: (#Function Text (#Function Code Code)) (function'' [name' body'] (form$ (#Cons (tag$ ["lux" "ExQ"]) (#Cons (tag$ ["lux" "Nil"]) @@ -1273,7 +1273,7 @@ #;Nil) (_lux_case (reverse tokens) (#Cons output inputs) - (return (#Cons (fold (_lux_: (#Function AST (#Function AST AST)) + (return (#Cons (fold (_lux_: (#Function Code (#Function Code Code)) (function'' [i o] (form$ (#Cons (tag$ ["lux" "Function"]) (#Cons i (#Cons o #Nil)))))) output inputs) @@ -1430,8 +1430,8 @@ (macro:' (let' tokens) (_lux_case tokens (#Cons [[_ (#Tuple bindings)] (#Cons [body #Nil])]) - (return (list (fold (_lux_: (-> (& AST AST) AST - AST) + (return (list (fold (_lux_: (-> (& Code Code) Code + Code) (function' [binding body] (_lux_case binding [label value] @@ -1457,7 +1457,7 @@ (def:''' (spliced? token) #Nil - (-> AST Bool) + (-> Code Bool) (_lux_case token [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [_ #Nil])]))] true @@ -1467,13 +1467,13 @@ (def:''' (wrap-meta content) #Nil - (-> AST AST) + (-> Code Code) (tuple$ (list (tuple$ (list (text$ "") (nat$ +0) (nat$ +0))) content))) (def:''' (untemplate-list tokens) #Nil - (-> ($' List AST) AST) + (-> ($' List Code) Code) (_lux_case tokens #Nil (_meta (#Tag ["lux" "Nil"])) @@ -1494,7 +1494,7 @@ (def:''' #export (splice-helper xs ys) (#Cons [["lux" "hidden?"] (#BoolA true)] #;Nil) - (-> ($' List AST) ($' List AST) ($' List AST)) + (-> ($' List Code) ($' List Code) ($' List Code)) (_lux_case xs (#Cons x xs') (#Cons x (splice-helper xs' ys)) @@ -1595,7 +1595,7 @@ (#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil))) (let' [g!wrap (symbol$ ["" "wrap"]) g!bind (symbol$ ["" " bind "]) - body' (fold (_lux_: (-> (& AST AST) AST AST) + body' (fold (_lux_: (-> (& Code Code) Code Code) (function' [binding body'] (let' [[var value] binding] (_lux_case var @@ -1744,15 +1744,15 @@ (def:''' (splice replace? untemplate tag elems) #Nil - (-> Bool (-> AST ($' Lux AST)) AST ($' List AST) ($' Lux AST)) + (-> Bool (-> Code ($' Lux Code)) Code ($' List Code) ($' Lux Code)) (_lux_case replace? true (_lux_case (any? spliced? elems) true (do Monad<Lux> - [elems' (_lux_: ($' Lux ($' List AST)) + [elems' (_lux_: ($' Lux ($' List Code)) (mapM Monad<Lux> - (_lux_: (-> AST ($' Lux AST)) + (_lux_: (-> Code ($' Lux Code)) (function' [elem] (_lux_case elem [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] @@ -1762,7 +1762,7 @@ (do Monad<Lux> [=elem (untemplate elem)] (wrap (form$ (list (symbol$ ["" "_lux_:"]) - (form$ (list (tag$ ["lux" "App"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "AST"]))))) + (form$ (list (tag$ ["lux" "App"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "Code"]))))) (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list =elem (tag$ ["lux" "Nil"])))))))))))) elems))] (wrap (wrap-meta (form$ (list tag @@ -1781,7 +1781,7 @@ (def:''' (untemplate replace? subst token) #Nil - (-> Bool Text AST ($' Lux AST)) + (-> Bool Text Code ($' Lux Code)) (_lux_case [replace? token] [_ [_ (#Bool value)]] (return (wrap-meta (form$ (list (tag$ ["lux" "Bool"]) (bool$ value))))) @@ -1850,7 +1850,7 @@ [_ [_ (#Record fields)]] (do Monad<Lux> [=fields (mapM Monad<Lux> - (_lux_: (-> (& AST AST) ($' Lux AST)) + (_lux_: (-> (& Code Code) ($' Lux Code)) (function' [kv] (let' [[k v] kv] (do Monad<Lux> @@ -1903,7 +1903,7 @@ (do Monad<Lux> [current-module current-module-name =template (untemplate true current-module template)] - (wrap (list (form$ (list (symbol$ ["" "_lux_:"]) (symbol$ ["lux" "AST"]) =template))))) + (wrap (list (form$ (list (symbol$ ["" "_lux_:"]) (symbol$ ["lux" "Code"]) =template))))) _ (fail "Wrong syntax for `"))) @@ -1917,7 +1917,7 @@ (#Cons template #Nil) (do Monad<Lux> [=template (untemplate true "" template)] - (wrap (list (form$ (list (symbol$ ["" "_lux_:"]) (symbol$ ["lux" "AST"]) =template))))) + (wrap (list (form$ (list (symbol$ ["" "_lux_:"]) (symbol$ ["lux" "Code"]) =template))))) _ (fail "Wrong syntax for `"))) @@ -1929,7 +1929,7 @@ (#Cons template #Nil) (do Monad<Lux> [=template (untemplate false "" template)] - (wrap (list (form$ (list (symbol$ ["" "_lux_:"]) (symbol$ ["lux" "AST"]) =template))))) + (wrap (list (form$ (list (symbol$ ["" "_lux_:"]) (symbol$ ["lux" "Code"]) =template))))) _ (fail "Wrong syntax for '"))) @@ -1944,7 +1944,7 @@ (map Int/encode elems)))")]) (_lux_case tokens (#Cons [init apps]) - (return (list (fold (_lux_: (-> AST AST AST) + (return (list (fold (_lux_: (-> Code Code Code) (function' [app acc] (_lux_case app [_ (#Tuple parts)] @@ -1971,7 +1971,7 @@ (map Int/encode elems)))")]) (_lux_case (reverse tokens) (#Cons [init apps]) - (return (list (fold (_lux_: (-> AST AST AST) + (return (list (fold (_lux_: (-> Code Code Code) (function' [app acc] (_lux_case app [_ (#Tuple parts)] @@ -1996,7 +1996,7 @@ (def:''' (get-ident x) #Nil - (-> AST ($' Maybe Ident)) + (-> Code ($' Maybe Ident)) (_lux_case x [_ (#Symbol sname)] (#Some sname) @@ -2006,7 +2006,7 @@ (def:''' (get-tag x) #Nil - (-> AST ($' Maybe Ident)) + (-> Code ($' Maybe Ident)) (_lux_case x [_ (#Tag sname)] (#Some sname) @@ -2016,7 +2016,7 @@ (def:''' (get-name x) #Nil - (-> AST ($' Maybe Text)) + (-> Code ($' Maybe Text)) (_lux_case x [_ (#Symbol "" sname)] (#Some sname) @@ -2026,7 +2026,7 @@ (def:''' (tuple->list tuple) #Nil - (-> AST ($' Maybe ($' List AST))) + (-> Code ($' Maybe ($' List Code))) (_lux_case tuple [_ (#Tuple members)] (#Some members) @@ -2036,7 +2036,7 @@ (def:''' (apply-template env template) #Nil - (-> RepEnv AST AST) + (-> RepEnv Code Code) (_lux_case template [_ (#Symbol "" sname)] (_lux_case (get-rep sname env) @@ -2053,7 +2053,7 @@ [meta (#Form (map (apply-template env) elems))] [meta (#Record members)] - [meta (#Record (map (_lux_: (-> (& AST AST) (& AST AST)) + [meta (#Record (map (_lux_: (-> (& Code Code) (& Code Code)) (function' [kv] (let' [[slot value] kv] [(apply-template env slot) (apply-template env value)]))) @@ -2093,7 +2093,7 @@ (_lux_case [(mapM Monad<Maybe> get-name bindings) (mapM Monad<Maybe> tuple->list data)] [(#Some bindings') (#Some data')] - (let' [apply (_lux_: (-> RepEnv ($' List AST)) + (let' [apply (_lux_: (-> RepEnv ($' List Code)) (function' [env] (map (apply-template env) templates))) num-bindings (length bindings')] (if (every? (function' [sample] (_lux_proc ["int" "="] [num-bindings sample])) @@ -2396,7 +2396,7 @@ (def:''' (macro-expand-once token) #Nil - (-> AST ($' Lux ($' List AST))) + (-> Code ($' Lux ($' List Code))) (_lux_case token [_ (#Form (#Cons [_ (#Symbol macro-name)] args))] (do Monad<Lux> @@ -2414,7 +2414,7 @@ (def:''' (macro-expand token) #Nil - (-> AST ($' Lux ($' List AST))) + (-> Code ($' Lux ($' List Code))) (_lux_case token [_ (#Form (#Cons [_ (#Symbol macro-name)] args))] (do Monad<Lux> @@ -2435,7 +2435,7 @@ (def:''' (macro-expand-all syntax) #Nil - (-> AST ($' Lux ($' List AST))) + (-> Code ($' Lux ($' List Code))) (_lux_case syntax [_ (#Form (#Cons [_ (#Symbol macro-name)] args))] (do Monad<Lux> @@ -2475,7 +2475,7 @@ (return [key val'']) _ - (fail "The value-part of a KV-pair in a record must macro-expand to a single AST."))))) + (fail "The value-part of a KV-pair in a record must macro-expand to a single Code."))))) pairs)] (wrap (list (record$ pairs')))) @@ -2484,7 +2484,7 @@ (def:''' (walk-type type) #Nil - (-> AST AST) + (-> Code Code) (_lux_case type [_ (#Form (#Cons [_ (#Tag tag)] parts))] (form$ (#Cons [(tag$ tag) (map walk-type parts)])) @@ -2493,7 +2493,7 @@ (` (& (~@ (map walk-type members)))) [_ (#Form (#Cons type-fn args))] - (fold (_lux_: (-> AST AST AST) + (fold (_lux_: (-> Code Code Code) (function' [arg type-fn] (` (#;App (~ type-fn) (~ arg))))) (walk-type type-fn) (map walk-type args)) @@ -2556,12 +2556,12 @@ (def:''' (unfold-type-def type-asts) #Nil - (-> ($' List AST) ($' Lux (& AST ($' Maybe ($' List Text))))) + (-> ($' List Code) ($' Lux (& Code ($' Maybe ($' List Text))))) (_lux_case type-asts (#Cons [_ (#Record pairs)] #;Nil) (do Monad<Lux> [members (mapM Monad<Lux> - (: (-> [AST AST] (Lux [Text AST])) + (: (-> [Code Code] (Lux [Text Code])) (function' [pair] (_lux_case pair [[_ (#Tag "" member-name)] member-type] @@ -2587,7 +2587,7 @@ (#Cons case cases) (do Monad<Lux> [members (mapM Monad<Lux> - (: (-> AST (Lux [Text AST])) + (: (-> Code (Lux [Text Code])) (function' [case] (_lux_case case [_ (#Tag "" member-name)] @@ -2610,7 +2610,7 @@ (def:''' (gensym prefix state) #Nil - (-> Text ($' Lux AST)) + (-> Text ($' Lux Code)) (_lux_case state {#info info #source source #modules modules #scopes scopes #type-context types #host host @@ -2648,7 +2648,7 @@ (_lux_case (reverse tokens) (#Cons value actions) (let' [dummy (symbol$ ["" ""])] - (return (list (fold (_lux_: (-> AST AST AST) + (return (list (fold (_lux_: (-> Code Code Code) (function' [pre post] (` (;_lux_case (~ pre) (~ dummy) (~ post))))) value actions)))) @@ -2663,7 +2663,7 @@ _ [false tokens]) - parts (: (Maybe [AST (List AST) (Maybe AST) AST]) + parts (: (Maybe [Code (List Code) (Maybe Code) Code]) (_lux_case tokens' (#Cons [_ (#Form (#Cons name args))] (#Cons type (#Cons body #Nil))) (#Some name args (#Some type) body) @@ -2702,12 +2702,12 @@ (fail "Wrong syntax for def'")))) (def:' (rejoin-pair pair) - (-> [AST AST] (List AST)) + (-> [Code Code] (List Code)) (let' [[left right] pair] (list left right))) (def:' (ast-to-text ast) - (-> AST Text) + (-> Code Text) (_lux_case ast [_ (#Bool value)] (Bool/encode value) @@ -2763,7 +2763,7 @@ )) (def:' (expander branches) - (-> (List AST) (Lux (List AST))) + (-> (List Code) (Lux (List Code))) (_lux_case branches (#;Cons [_ (#Form (#Cons [_ (#Symbol macro-name)] macro-args))] (#;Cons body @@ -2871,7 +2871,7 @@ (fail "Wrong syntax for ^or"))) (def:' (symbol? ast) - (-> AST Bool) + (-> Code Bool) (case ast [_ (#Symbol _)] true @@ -2889,7 +2889,7 @@ (^ (list [_ (#Tuple bindings)] body)) (if (multiple? 2 (length bindings)) (|> bindings as-pairs reverse - (fold (: (-> [AST AST] AST AST) + (fold (: (-> [Code Code] Code Code) (function' [lr body'] (let' [[l r] lr] (if (symbol? l) @@ -2911,7 +2911,7 @@ (: (All [a b] (-> a b a)) (function const [x y] x))")]) - (case (: (Maybe [Ident AST (List AST) AST]) + (case (: (Maybe [Ident Code (List Code) Code]) (case tokens (^ (list [_ (#Tuple (#Cons head tail))] body)) (#Some ["" ""] head tail body) @@ -2924,7 +2924,7 @@ (#Some ident head tail body) (let [g!blank (symbol$ ["" ""]) g!name (symbol$ ident) - body+ (fold (: (-> AST AST AST) + body+ (fold (: (-> Code Code Code) (function' [arg body'] (if (symbol? arg) (` (;_lux_function (~ g!blank) (~ arg) (~ body'))) @@ -2940,7 +2940,7 @@ (fail "Wrong syntax for function"))) (def:' (process-def-meta-value ast) - (-> AST (Lux AST)) + (-> Code (Lux Code)) (case ast [_ (#Bool value)] (return (form$ (list (tag$ ["lux" "BoolA"]) (bool$ value)))) @@ -2977,7 +2977,7 @@ [_ (#Record kvs)] (do Monad<Lux> [=xs (mapM Monad<Lux> - (: (-> [AST AST] (Lux AST)) + (: (-> [Code Code] (Lux Code)) (function [[k v]] (case k [_ (#Text =k)] @@ -2992,12 +2992,12 @@ )) (def:' (process-def-meta ast) - (-> AST (Lux AST)) + (-> Code (Lux Code)) (case ast [_ (#Record kvs)] (do Monad<Lux> [=kvs (mapM Monad<Lux> - (: (-> [AST AST] (Lux AST)) + (: (-> [Code Code] (Lux Code)) (function [[k v]] (case k [_ (#Tag [pk nk])] @@ -3015,7 +3015,7 @@ (fail (Text/append "Wrong syntax for Anns: " (ast-to-text ast))))) (def:' (with-func-args args meta) - (-> (List AST) AST AST) + (-> (List Code) Code Code) (case args #;Nil meta @@ -3028,7 +3028,7 @@ (~ meta))))) (def:' (with-type-args args) - (-> (List AST) AST) + (-> (List Code) Code) (` {#;type-args (#;ListA (list (~@ (map (function [arg] (` (#;TextA (~ (text$ (ast-to-text arg)))))) args))))})) @@ -3041,7 +3041,7 @@ )) (def:' (export-level^ tokens) - (-> (List AST) [(Maybe Export-Level) (List AST)]) + (-> (List Code) [(Maybe Export-Level) (List Code)]) (case tokens (#Cons [_ (#Tag [_ "export"])] tokens') [(#;Some (#;Left [])) tokens'] @@ -3053,7 +3053,7 @@ [#;None tokens])) (def:' (export-level ?el) - (-> (Maybe Export-Level) (List AST)) + (-> (Maybe Export-Level) (List Code)) (case ?el #;None (list) @@ -3067,7 +3067,7 @@ (macro:' #export (def: tokens) (list [["lux" "doc"] (#TextA "## Defines global constants/functions. (def: (rejoin-pair pair) - (-> [AST AST] (List AST)) + (-> [Code Code] (List Code)) (let [[left right] pair] (list left right))) @@ -3075,7 +3075,7 @@ Int 5)")]) (let [[export? tokens'] (export-level^ tokens) - parts (: (Maybe [AST (List AST) (Maybe AST) AST AST]) + parts (: (Maybe [Code (List Code) (Maybe Code) Code Code]) (case tokens' (^ (list [_ (#Form (#Cons name args))] meta type body)) (#Some [name args (#Some type) body meta]) @@ -3137,7 +3137,7 @@ (fail "Wrong syntax for def")))) (def: (meta-ast-add addition meta) - (-> [AST AST] AST AST) + (-> [Code Code] Code Code) (case [addition meta] [[name value] [cursor (#;Record pairs)]] [cursor (#;Record (#;Cons [name value] pairs))] @@ -3146,7 +3146,7 @@ meta)) (def: (meta-ast-merge addition base) - (-> AST AST AST) + (-> Code Code Code) (case addition [cursor (#;Record pairs)] (fold meta-ast-add base pairs) @@ -3167,7 +3167,7 @@ _ (fail \"Wrong syntax for ident-for\")))")]) (let [[exported? tokens] (export-level^ tokens) - name+args+meta+body?? (: (Maybe [Ident (List AST) AST AST]) + name+args+meta+body?? (: (Maybe [Ident (List Code) Code Code]) (case tokens (^ (list [_ (#;Form (list& [_ (#Symbol name)] args))] body)) (#Some [name args (` {}) body]) @@ -3215,7 +3215,7 @@ (: (-> a a Bool) >=))"} (let [[exported? tokens'] (export-level^ tokens) - ?parts (: (Maybe [Ident (List AST) AST (List AST)]) + ?parts (: (Maybe [Ident (List Code) Code (List Code)]) (case tokens' (^ (list& [_ (#Form (list& [_ (#Symbol name)] args))] [meta-rec-cursor (#;Record meta-rec-parts)] sigs)) (#Some name args [meta-rec-cursor (#;Record meta-rec-parts)] sigs) @@ -3236,9 +3236,9 @@ (do Monad<Lux> [name+ (normalize name) sigs' (mapM Monad<Lux> macro-expand sigs) - members (: (Lux (List [Text AST])) + members (: (Lux (List [Text Code])) (mapM Monad<Lux> - (: (-> AST (Lux [Text AST])) + (: (-> Code (Lux [Text Code])) (function [token] (case token (^ [_ (#Form (list [_ (#Symbol _ "_lux_:")] type [_ (#Symbol ["" name])]))]) @@ -3249,7 +3249,7 @@ (List/join sigs'))) #let [[_module _name] name+ def-name (symbol$ name) - sig-type (record$ (map (: (-> [Text AST] [AST AST]) + sig-type (record$ (map (: (-> [Text Code] [Code Code]) (function [[m-name m-type]] [(tag$ ["" m-name]) m-type])) members)) @@ -3312,7 +3312,7 @@ (default 20 #;None) => 20"} (case tokens (^ (list else maybe)) - (let [g!temp (: AST [_cursor (#;Symbol ["" ""])]) + (let [g!temp (: Code [_cursor (#;Symbol ["" ""])]) code (` (case (~ maybe) (#;Some (~ g!temp)) (~ g!temp) @@ -3570,11 +3570,11 @@ _ (fail "No tags available for type."))) - #let [tag-mappings (: (List [Text AST]) + #let [tag-mappings (: (List [Text Code]) (map (function [tag] [(second tag) (tag$ tag)]) tags))] members (mapM Monad<Lux> - (: (-> AST (Lux [AST AST])) + (: (-> Code (Lux [Code Code])) (function [token] (case token (^ [_ (#Form (list [_ (#Symbol _ "_lux_def")] [_ (#Symbol "" tag-name)] value meta))]) @@ -3609,7 +3609,7 @@ (or (lux;> test subject) (lux;= test subject))))"} (let [[exported? tokens'] (export-level^ tokens) - ?parts (: (Maybe [AST (List AST) AST AST (List AST)]) + ?parts (: (Maybe [Code (List Code) Code Code (List Code)]) (case tokens' (^ (list& [_ (#Form (list& name args))] [meta-rec-cursor (#;Record meta-rec-parts)] type defs)) (#Some name args type [meta-rec-cursor (#;Record meta-rec-parts)] defs) @@ -3684,7 +3684,7 @@ {#;doc <doc-msg>} (case (reverse tokens) (^ (list& last init)) - (return (list (fold (: (-> AST AST AST) + (return (list (fold (: (-> Code Code Code) (function [pre post] (` <form>))) last init))) @@ -3707,7 +3707,7 @@ _ [false tokens']) - parts (: (Maybe [Text (List AST) AST (List AST)]) + parts (: (Maybe [Text (List Code) Code (List Code)]) (case tokens' (^ (list [_ (#Symbol "" name)] [meta-cursor (#;Record meta-parts)] [type-cursor (#;Record type-parts)])) (#Some [name #Nil [meta-cursor (#;Record meta-parts)] (list [type-cursor (#;Record type-parts)])]) @@ -3736,10 +3736,10 @@ module-name current-module-name] (let [type-name (symbol$ ["" name]) [type tags??] type+tags?? - type-meta (: AST + type-meta (: Code (case tags?? (#Some tags) - (` {#;tags [(~@ (map (: (-> Text AST) + (` {#;tags [(~@ (map (: (-> Text Code) (function' [tag] (form$ (list (tag$ ["lux" "TextA"]) (text$ tag))))) @@ -3748,7 +3748,7 @@ _ (` {#;type? true}))) - type' (: (Maybe AST) + type' (: (Maybe Code) (if rec? (if (empty? args) (let [g!param (symbol$ ["" ""]) @@ -3801,9 +3801,9 @@ #import-refer Refer}) (def: (extract-defs defs) - (-> (List AST) (Lux (List Text))) + (-> (List Code) (Lux (List Text))) (mapM Monad<Lux> - (: (-> AST (Lux Text)) + (: (-> Code (Lux Text)) (function [def] (case def [_ (#Symbol ["" name])] @@ -3814,7 +3814,7 @@ defs)) (def: (parse-alias tokens) - (-> (List AST) (Lux [(Maybe Text) (List AST)])) + (-> (List Code) (Lux [(Maybe Text) (List Code)])) (case tokens (^ (list& [_ (#Tag "" "as")] [_ (#Symbol "" alias)] tokens')) (return [(#Some alias) tokens']) @@ -3823,7 +3823,7 @@ (return [#None tokens]))) (def: (parse-referrals tokens) - (-> (List AST) (Lux [Referrals (List AST)])) + (-> (List Code) (Lux [Referrals (List Code)])) (case tokens (^ (list& [_ (#Tag ["" "refer"])] referral tokens')) (case referral @@ -3865,7 +3865,7 @@ [(reverse ys') xs'])) (def: (parse-short-referrals tokens) - (-> (List AST) (Lux [Referrals (List AST)])) + (-> (List Code) (Lux [Referrals (List Code)])) (case tokens (^ (list& [_ (#Tag "" "+")] tokens')) (let [[defs tokens'] (split-with symbol? tokens')] @@ -3886,7 +3886,7 @@ (return [#Nothing tokens]))) (def: (extract-symbol syntax) - (-> AST (Lux Ident)) + (-> Code (Lux Ident)) (case syntax [_ (#Symbol ident)] (return ident) @@ -3895,11 +3895,11 @@ (fail "Not a symbol."))) (def: (parse-openings tokens) - (-> (List AST) (Lux [(List Openings) (List AST)])) + (-> (List Code) (Lux [(List Openings) (List Code)])) (case tokens (^ (list& [_ (#Tag "" "open")] [_ (#Form parts)] tokens')) (if (|> parts - (map (: (-> AST Bool) + (map (: (-> Code Bool) (function [part] (case part (^or [_ (#Text _)] [_ (#Symbol _)]) @@ -3908,7 +3908,7 @@ _ false)))) (fold (function [r l] (and l r)) true)) - (let [openings (fold (: (-> AST (List Openings) (List Openings)) + (let [openings (fold (: (-> Code (List Openings) (List Openings)) (function [part openings] (case part [_ (#Text prefix)] @@ -3933,9 +3933,9 @@ (return [(list) tokens]))) (def: (parse-short-openings parts) - (-> (List AST) (Lux [(List Openings) (List AST)])) + (-> (List Code) (Lux [(List Openings) (List Code)])) (if (|> parts - (map (: (-> AST Bool) + (map (: (-> Code Bool) (function [part] (case part (^or [_ (#Text _)] [_ (#Symbol _)]) @@ -3944,7 +3944,7 @@ _ false)))) (fold (function [r l] (and l r)) true)) - (let [openings (fold (: (-> AST (List Openings) (List Openings)) + (let [openings (fold (: (-> Code (List Openings) (List Openings)) (function [part openings] (case part [_ (#Text prefix)] @@ -4005,10 +4005,10 @@ )) (def: (parse-imports imports) - (-> (List AST) (Lux (List Importation))) + (-> (List Code) (Lux (List Importation))) (do Monad<Lux> [imports' (mapM Monad<Lux> - (: (-> AST (Lux (List Importation))) + (: (-> Code (Lux (List Importation))) (function [token] (case token [_ (#Symbol "" m-name)] @@ -4297,7 +4297,7 @@ (#;Some tags&members) (do Monad<Lux> - [full-body ((: (-> Ident [(List Ident) (List Type)] AST (Lux AST)) + [full-body ((: (-> Ident [(List Ident) (List Type)] Code (Lux Code)) (function recur [source [tags members] target] (let [pattern (record$ (map (function [[t-module t-name]] [(tag$ [t-module t-name]) @@ -4353,7 +4353,7 @@ (fail "cond requires an even number of arguments.") (case (reverse tokens) (^ (list& else branches')) - (return (list (fold (: (-> [AST AST] AST AST) + (return (list (fold (: (-> [Code Code] Code Code) (function [branch else] (let [[right left] branch] (` (if (~ left) (~ right) (~ else)))))) @@ -4397,7 +4397,7 @@ g!output (gensym "")] (case (resolve-struct-type type) (#Some members) - (let [pattern (record$ (map (: (-> [Ident [Nat Type]] [AST AST]) + (let [pattern (record$ (map (: (-> [Ident [Nat Type]] [Code Code]) (function [[[r-prefix r-name] [r-idx r-type]]] [(tag$ [r-prefix r-name]) (if (n.= idx r-idx) g!output @@ -4409,7 +4409,7 @@ (fail "get@ can only use records."))) (^ (list [_ (#Tuple slots)] record)) - (return (list (fold (: (-> AST AST AST) + (return (list (fold (: (-> Code Code Code) (function [slot inner] (` (;;get@ (~ slot) (~ inner))))) record @@ -4424,7 +4424,7 @@ (fail "Wrong syntax for get@"))) (def: (open-field prefix [module name] source type) - (-> Text Ident AST Type (Lux (List AST))) + (-> Text Ident Code Type (Lux (List Code))) (do Monad<Lux> [output (resolve-type-tags type) #let [source+ (` (get@ (~ (tag$ [module name])) (~ source)))]] @@ -4432,7 +4432,7 @@ (#Some [tags members]) (do Monad<Lux> [decls' (mapM Monad<Lux> - (: (-> [Ident Type] (Lux (List AST))) + (: (-> [Ident Type] (Lux (List Code))) (function [[sname stype]] (open-field prefix sname source+ stype))) (zip2 tags members))] (return (List/join decls'))) @@ -4466,7 +4466,7 @@ (case output (#Some [tags members]) (do Monad<Lux> - [decls' (mapM Monad<Lux> (: (-> [Ident Type] (Lux (List AST))) + [decls' (mapM Monad<Lux> (: (-> [Ident Type] (Lux (List Code))) (function [[sname stype]] (open-field prefix sname source stype))) (zip2 tags members))] (return (List/join decls'))) @@ -4509,7 +4509,7 @@ (wrap (is-member? imports import-name)))) (def: (read-refer module-name options) - (-> Text (List AST) (Lux Refer)) + (-> Text (List Code) (Lux Refer)) (do Monad<Lux> [referral+options (parse-referrals options) #let [[referral options] referral+options] @@ -4538,7 +4538,7 @@ (fold Text/append ""))))))) (def: (write-refer module-name [r-defs r-opens]) - (-> Text Refer (Lux (List AST))) + (-> Text Refer (Lux (List Code))) (do Monad<Lux> [current-module current-module-name #let [test-referrals (: (-> Text (List Text) (List Text) (Lux (List Unit))) @@ -4568,14 +4568,14 @@ #Nothing (wrap (list))) - #let [defs (map (: (-> Text AST) + #let [defs (map (: (-> Text Code) (function [def] (` (;_lux_def (~ (symbol$ ["" def])) (~ (symbol$ [module-name def])) (#Cons [["lux" "alias"] (#IdentA [(~ (text$ module-name)) (~ (text$ def))])] #Nil))))) defs') - openings (join-map (: (-> Openings (List AST)) + openings (join-map (: (-> Openings (List Code)) (function [[prefix structs]] (map (function [[_ name]] (` (open (~ (symbol$ [module-name name])) (~ (text$ prefix))))) structs))) @@ -4594,8 +4594,8 @@ (fail "Wrong syntax for refer"))) (def: (refer-to-ast module-name [r-defs r-opens]) - (-> Text Refer AST) - (let [=defs (: (List AST) + (-> Text Refer Code) + (let [=defs (: (List Code) (case r-defs #All (list (' #refer) (' #all)) @@ -4645,7 +4645,7 @@ (macro ast)) (.. [type \"\" Eq<Type>]))"} (do Monad<Lux> - [#let [[_meta _imports] (: [(List [AST AST]) (List AST)] + [#let [[_meta _imports] (: [(List [Code Code]) (List Code)] (case tokens (^ (list& [_ (#Record _meta)] _imports)) [_meta _imports] @@ -4653,11 +4653,11 @@ _ [(list) tokens]))] imports (parse-imports _imports) - #let [=imports (map (: (-> Importation AST) + #let [=imports (map (: (-> Importation Code) (function [[m-name m-alias =refer]] (` [(~ (text$ m-name)) (~ (text$ (default "" m-alias)))]))) imports) - =refers (map (: (-> Importation AST) + =refers (map (: (-> Importation Code) (function [[m-name m-alias =refer]] (refer-to-ast m-name =refer))) imports)] @@ -4706,17 +4706,17 @@ (#Some members) (do Monad<Lux> [pattern' (mapM Monad<Lux> - (: (-> [Ident [Nat Type]] (Lux [Ident Nat AST])) + (: (-> [Ident [Nat Type]] (Lux [Ident Nat Code])) (function [[r-slot-name [r-idx r-type]]] (do Monad<Lux> [g!slot (gensym "")] (return [r-slot-name r-idx g!slot])))) (zip2 tags (enumerate members)))] - (let [pattern (record$ (map (: (-> [Ident Nat AST] [AST AST]) + (let [pattern (record$ (map (: (-> [Ident Nat Code] [Code Code]) (function [[r-slot-name r-idx r-var]] [(tag$ r-slot-name) r-var])) pattern')) - output (record$ (map (: (-> [Ident Nat AST] [AST AST]) + output (record$ (map (: (-> [Ident Nat Code] [Code Code]) (function [[r-slot-name r-idx r-var]] [(tag$ r-slot-name) (if (n.= idx r-idx) value @@ -4735,20 +4735,20 @@ _ (do Monad<Lux> [bindings (mapM Monad<Lux> - (: (-> AST (Lux AST)) + (: (-> Code (Lux Code)) (function [_] (gensym "temp"))) slots) #let [pairs (zip2 slots bindings) - update-expr (fold (: (-> [AST AST] AST AST) + update-expr (fold (: (-> [Code Code] Code Code) (function [[s b] v] (` (;;set@ (~ s) (~ v) (~ b))))) value (reverse pairs)) - [_ accesses'] (fold (: (-> [AST AST] [AST (List (List AST))] [AST (List (List AST))]) + [_ accesses'] (fold (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))]) (function [[new-slot new-binding] [old-record accesses']] [(` (get@ (~ new-slot) (~ new-binding))) (#;Cons (list new-binding old-record) accesses')])) - [record (: (List (List AST)) #;Nil)] + [record (: (List (List Code)) #;Nil)] pairs) accesses (List/join (reverse accesses'))]] (wrap (list (` (let [(~@ accesses)] @@ -4792,17 +4792,17 @@ (#Some members) (do Monad<Lux> [pattern' (mapM Monad<Lux> - (: (-> [Ident [Nat Type]] (Lux [Ident Nat AST])) + (: (-> [Ident [Nat Type]] (Lux [Ident Nat Code])) (function [[r-slot-name [r-idx r-type]]] (do Monad<Lux> [g!slot (gensym "")] (return [r-slot-name r-idx g!slot])))) (zip2 tags (enumerate members)))] - (let [pattern (record$ (map (: (-> [Ident Nat AST] [AST AST]) + (let [pattern (record$ (map (: (-> [Ident Nat Code] [Code Code]) (function [[r-slot-name r-idx r-var]] [(tag$ r-slot-name) r-var])) pattern')) - output (record$ (map (: (-> [Ident Nat AST] [AST AST]) + output (record$ (map (: (-> [Ident Nat Code] [Code Code]) (function [[r-slot-name r-idx r-var]] [(tag$ r-slot-name) (if (n.= idx r-idx) (` ((~ fun) (~ r-var))) @@ -4880,12 +4880,12 @@ (^ (list& [_ (#Form (list& [_ (#Tuple bindings)] templates))] [_ (#Form data)] branches)) - (case (: (Maybe (List AST)) + (case (: (Maybe (List Code)) (do Monad<Maybe> [bindings' (mapM Monad<Maybe> get-name bindings) data' (mapM Monad<Maybe> tuple->list data)] (if (every? (i.= (length bindings')) (map length data')) - (let [apply (: (-> RepEnv (List AST)) + (let [apply (: (-> RepEnv (List Code)) (function [env] (map (apply-template env) templates)))] (|> data' (join-map (. apply (make-env bindings'))) @@ -4910,7 +4910,7 @@ ) (def: (find-baseline-column ast) - (-> AST Nat) + (-> Code Nat) (case ast (^template [<tag>] [[_ _ column] (<tag> _)] @@ -4939,10 +4939,10 @@ (type: Doc-Fragment (#Doc-Comment Text) - (#Doc-Example AST)) + (#Doc-Example Code)) (def: (identify-doc-fragment ast) - (-> AST Doc-Fragment) + (-> Code Doc-Fragment) (case ast [_ (#;Text comment)] (#Doc-Comment comment) @@ -5022,11 +5022,11 @@ [file line (n.inc column)]) (def: rejoin-all-pairs - (-> (List [AST AST]) (List AST)) + (-> (List [Code Code]) (List Code)) (. List/join (map rejoin-pair))) (def: (doc-example->Text prev-cursor baseline example) - (-> Cursor Nat AST [Cursor Text]) + (-> Cursor Nat Code [Cursor Text]) (case example (^template [<tag> <show>] [new-cursor (<tag> value)] @@ -5114,7 +5114,7 @@ (list& x y (interleave xs' ys'))))) (def: (type-to-ast type) - (-> Type AST) + (-> Type Code) (case type (#Host name params) (` (#Host (~ (text$ name)) (~ (untemplate-list (map type-to-ast params))))) @@ -5185,7 +5185,7 @@ (~@ inits)))))) (do Monad<Lux> [aliases (mapM Monad<Lux> - (: (-> AST (Lux AST)) + (: (-> Code (Lux Code)) (function [_] (gensym ""))) inits)] (return (list (` (let [(~@ (interleave aliases inits))] @@ -5220,10 +5220,10 @@ output (resolve-tag hslot) g!_ (gensym "_") #let [[idx tags exported? type] output - slot-pairings (map (: (-> Ident [Text AST]) + slot-pairings (map (: (-> Ident [Text Code]) (function [[module name]] [name (symbol$ ["" name])])) (list& hslot tslots)) - pattern (record$ (map (: (-> Ident [AST AST]) + pattern (record$ (map (: (-> Ident [Code Code]) (function [[module name]] (let [tag (tag$ [module name])] (case (get name slot-pairings) @@ -5236,7 +5236,7 @@ (fail "Wrong syntax for ^slots"))) (def: (place-tokens label tokens target) - (-> Text (List AST) AST (Maybe (List AST))) + (-> Text (List Code) Code (Maybe (List Code))) (case target (^or [_ (#Bool _)] [_ (#Nat _)] [_ (#Int _)] [_ (#Deg _)] [_ (#Real _)] [_ (#Char _)] [_ (#Text _)] [_ (#Tag _)]) (#Some (list target)) @@ -5258,7 +5258,7 @@ [_ (#Record pairs)] (do Monad<Maybe> [=pairs (mapM Monad<Maybe> - (: (-> [AST AST] (Maybe [AST AST])) + (: (-> [Code Code] (Maybe [Code Code])) (function [[slot value]] (do Monad<Maybe> [slot' (place-tokens label tokens slot) @@ -5275,14 +5275,14 @@ (macro: #export (with-expansions tokens) {#;doc (doc "Controlled macro-expansion." - "Bind an arbitraty number of ASTs resulting from macro-expansion to local bindings." - "Wherever a binding appears, the bound ASTs will be spliced in there." - (test: "AST operations & structures" + "Bind an arbitraty number of Codes resulting from macro-expansion to local bindings." + "Wherever a binding appears, the bound Codes will be spliced in there." + (test: "Code operations & structures" (with-expansions [<tests> (do-template [<expr> <text> <pattern>] [(compare <pattern> <expr>) - (compare <text> (:: AST/encode show <expr>)) - (compare true (:: Eq<AST> = <expr> <expr>))] + (compare <text> (:: Code/encode show <expr>)) + (compare true (:: Eq<Code> = <expr> <expr>))] [(bool true) "true" [_ (#;Bool true)]] [(bool false) "false" [_ (#;Bool false)]] @@ -5344,7 +5344,7 @@ type)) (def: (anti-quote-def name) - (-> Ident (Lux AST)) + (-> Ident (Lux Code)) (do Monad<Lux> [type+value (find-def-value name) #let [[type value] type+value]] @@ -5364,7 +5364,7 @@ (fail (Text/append "Cannot anti-quote type: " (Ident/encode name)))))) (def: (anti-quote token) - (-> AST (Lux AST)) + (-> Code (Lux Code)) (case token [_ (#Symbol [def-prefix def-name])] (if (Text/= "" def-prefix) @@ -5382,7 +5382,7 @@ [meta (#Record pairs)] (do Monad<Lux> [=pairs (mapM Monad<Lux> - (: (-> [AST AST] (Lux [AST AST])) + (: (-> [Code Code] (Lux [Code Code])) (function [[slot value]] (do Monad<Lux> [=value (anti-quote value)] @@ -5423,10 +5423,10 @@ (fail "Wrong syntax for ^~"))) (type: Multi-Level-Case - [AST (List [AST AST])]) + [Code (List [Code Code])]) (def: (case-level^ level) - (-> AST (Lux [AST AST])) + (-> Code (Lux [Code Code])) (case level (^ [_ (#;Tuple (list expr binding))]) (return [expr binding]) @@ -5436,7 +5436,7 @@ )) (def: (multi-level-case^ levels) - (-> (List AST) (Lux Multi-Level-Case)) + (-> (List Code) (Lux Multi-Level-Case)) (case levels #;Nil (fail "Multi-level patterns cannot be empty.") @@ -5447,7 +5447,7 @@ (wrap [init extras'])))) (def: (multi-level-case$ g!_ [[init-pattern levels] body]) - (-> AST [Multi-Level-Case AST] (List AST)) + (-> Code [Multi-Level-Case Code] (List Code)) (let [inner-pattern-body (fold (function [[calculation pattern] success] (` (case (~ calculation) (~ pattern) @@ -5456,7 +5456,7 @@ (~ g!_) #;None))) (` (#;Some (~ body))) - (: (List [AST AST]) (reverse levels)))] + (: (List [Code Code]) (reverse levels)))] (list init-pattern inner-pattern-body))) (macro: #export (^=> tokens) @@ -5661,7 +5661,7 @@ #Hidden) (def: (parse-export-level tokens) - (-> (List AST) (Lux [(Maybe Export-Level') (List AST)])) + (-> (List Code) (Lux [(Maybe Export-Level') (List Code)])) (case tokens (^ (list& [_ (#Tag ["" "export"])] tokens')) (:: Monad<Lux> wrap [(#;Some #Export) tokens']) @@ -5674,7 +5674,7 @@ )) (def: (gen-export-level ?export-level) - (-> (Maybe Export-Level') (List AST)) + (-> (Maybe Export-Level') (List Code)) (case ?export-level #;None (list) @@ -5687,7 +5687,7 @@ )) (def: (parse-complex-declaration tokens) - (-> (List AST) (Lux [[Text (List Text)] (List AST)])) + (-> (List Code) (Lux [[Text (List Text)] (List Code)])) (case tokens (^ (list& [_ (#Form (list& [_ (#Symbol ["" name])] args'))] tokens')) (do Monad<Lux> @@ -5707,7 +5707,7 @@ )) (def: (parse-any tokens) - (-> (List AST) (Lux [AST (List AST)])) + (-> (List Code) (Lux [Code (List Code)])) (case tokens (^ (list& token tokens')) (:: Monad<Lux> wrap [token tokens']) @@ -5717,17 +5717,17 @@ )) (def: (parse-end tokens) - (-> (List AST) (Lux Unit)) + (-> (List Code) (Lux Unit)) (case tokens (^ (list)) (:: Monad<Lux> wrap []) _ - (fail "Expected input ASTs to be empty.") + (fail "Expected input Codes to be empty.") )) (def: (parse-anns tokens) - (-> (List AST) (Lux [AST (List AST)])) + (-> (List Code) (Lux [Code (List Code)])) (case tokens (^ (list& [_ (#Record _anns)] tokens')) (:: Monad<Lux> wrap [(record$ _anns) tokens']) diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux index d171dc899..fd20a208b 100644 --- a/stdlib/source/lux/cli.lux +++ b/stdlib/source/lux/cli.lux @@ -9,7 +9,7 @@ (sum #as sum)) [io] [macro #+ with-gensyms Functor<Lux> Monad<Lux>] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax]))) ## [Types] @@ -228,14 +228,14 @@ ## [Syntax] (type: Program-Args (#Raw-Program-Args Text) - (#Parsed-Program-Args (List [AST AST]))) + (#Parsed-Program-Args (List [Code Code]))) (def: program-args^ (Syntax Program-Args) (s;alt s;local-symbol (s;form (s;some (s;either (do s;Monad<Syntax> [name s;local-symbol] - (wrap [(ast;symbol ["" name]) (` any)])) + (wrap [(code;symbol ["" name]) (` any)])) (s;tuple (s;seq s;any s;any))))))) (syntax: #export (program: [args program-args^] body) @@ -256,7 +256,7 @@ (do-something data))))} (case args (#Raw-Program-Args args) - (wrap (list (` (;_lux_program (~ (ast;symbol ["" args])) + (wrap (list (` (;_lux_program (~ (code;symbol ["" args])) (~ body))))) (#Parsed-Program-Args args) diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index 14e382e1c..42b8908f9 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -9,7 +9,7 @@ [product] [number "Nat/" Codec<Text,Nat>]) [macro #+ with-gensyms] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax] (syntax [common])) [type]) @@ -128,7 +128,7 @@ (wrap (#;Right new-server)))) )))) #end (function [_ server] (exec (io;run (poison server)) - (:: Monad<Promise> wrap [])))})))] + (:: Monad<Promise> wrap [])))})))] (update@ #obituary (: (-> (P;Promise [(Maybe Text) (Actor ($ +0) ($ +1)) (List ($ +1))]) (P;Promise [(Maybe Text) ($ +0) (List ($ +1))])) (function [process] @@ -142,9 +142,9 @@ (type: Method {#name Text #vars (List Text) - #args (List [Text AST]) - #return AST - #body AST}) + #args (List [Text Code]) + #return Code + #body Code}) (def: method^ (Syntax Method) @@ -164,20 +164,20 @@ #body body})))) (def: stop^ - (Syntax AST) + (Syntax Code) (s;form (do s;Monad<Syntax> [_ (s;this! (' stop:))] s;any))) (def: actor-decl^ - (Syntax [(List Text) Text (List [Text AST])]) + (Syntax [(List Text) Text (List [Text Code])]) (s;seq (s;default (list) (s;tuple (s;some s;local-symbol))) (s;either (s;form (s;seq s;local-symbol (s;many common;typed-arg))) (s;seq s;local-symbol (:: s;Monad<Syntax> wrap (list)))))) (def: (actor-def-decl [_vars _name _args] return-type) - (-> [(List Text) Text (List [Text AST])] AST (List AST)) - (let [decl (` ((~ (ast;symbol ["" (format _name "//new")])) (~@ (List/map (|>. product;left [""] ast;symbol) _args)))) + (-> [(List Text) Text (List [Text Code])] Code (List Code)) + (let [decl (` ((~ (code;symbol ["" (format _name "//new")])) (~@ (List/map (|>. product;left [""] code;symbol) _args)))) base-type (` (-> (~@ (List/map product;right _args)) (~ return-type))) type (case _vars @@ -185,7 +185,7 @@ base-type _ - (` (All [(~@ (List/map (|>. [""] ast;symbol) _vars))] + (` (All [(~@ (List/map (|>. [""] code;symbol) _vars))] (~ base-type))))] (list decl type))) @@ -213,20 +213,20 @@ (wrap (#;Left "Cannot add negative numbers!")))) ))} (with-gensyms [g!message g!error g!return g!error g!output] - (let [g!state-name (ast;symbol ["" (format _name "//STATE")]) - g!protocol-name (ast;symbol ["" (format _name "//PROTOCOL")]) - g!self (ast;symbol ["" "*self*"]) - g!state (ast;symbol ["" "*state*"]) - g!cause (ast;symbol ["" "*cause*"]) + (let [g!state-name (code;symbol ["" (format _name "//STATE")]) + g!protocol-name (code;symbol ["" (format _name "//PROTOCOL")]) + g!self (code;symbol ["" "*self*"]) + g!state (code;symbol ["" "*state*"]) + g!cause (code;symbol ["" "*cause*"]) g!stop-body (default (` (:: P;Monad<Promise> (~' wrap) [])) ?stop) protocol (List/map (function [(^slots [#name #vars #args #return #body])] - (` ((~ (ast;tag ["" name])) [(~@ (List/map product;right args))] (P;Promise (~ return))))) + (` ((~ (code;tag ["" name])) [(~@ (List/map product;right args))] (P;Promise (~ return))))) methods) - protocol-pm (List/map (: (-> Method [AST AST]) + protocol-pm (List/map (: (-> Method [Code Code]) (function [(^slots [#name #vars #args #return #body])] - (let [arg-names (|> (list;size args) (list;n.range +1) (List/map (|>. Nat/encode [""] ast;symbol))) + (let [arg-names (|> (list;size args) (list;n.range +1) (List/map (|>. Nat/encode [""] code;symbol))) body-func (` (: (-> (~ g!state-name) (~@ (List/map product;right args)) (P;Promise (Error [(~ g!state-name) (~ return)]))) - (function (~ (ast;symbol ["" _name])) [(~ g!state) (~@ (List/map (|>. product;left [""] ast;symbol) args))] + (function (~ (code;symbol ["" _name])) [(~ g!state) (~@ (List/map (|>. product;left [""] code;symbol) args))] (do P;Monad<Promise> [] (~ body)))))] @@ -249,7 +249,7 @@ (list pattern clause)) protocol-pm)) (List/join (List/map (function [[method [pattern clause]]] - (list (` ((~ (ast;tag ["" (get@ #name method)])) (~ pattern))) + (list (` ((~ (code;tag ["" (get@ #name method)])) (~ pattern))) clause)) (list;zip2 methods protocol-pm))))) )) @@ -257,17 +257,17 @@ (do P;Monad<Promise> [] (~ g!stop-body)))}) - g!actor-name (ast;symbol ["" _name]) - g!methods (List/map (: (-> Method AST) + g!actor-name (code;symbol ["" _name]) + g!methods (List/map (: (-> Method Code) (function [(^slots [#name #vars #args #return #body])] - (let [arg-names (|> (list;size args) (list;n.range +1) (List/map (|>. Nat/encode [""] ast;symbol))) + (let [arg-names (|> (list;size args) (list;n.range +1) (List/map (|>. Nat/encode [""] code;symbol))) type (` (-> (~@ (List/map product;right args)) (~ g!actor-name) (P;Promise (~ return))))] - (` (def: (~@ (common;gen-export-level _ex-lev)) ((~ (ast;symbol ["" name])) (~@ arg-names) (~ g!self)) + (` (def: (~@ (common;gen-export-level _ex-lev)) ((~ (code;symbol ["" name])) (~@ arg-names) (~ g!self)) (~ type) (let [(~ g!output) (P;promise (~ return))] - (exec (send ((~ (ast;tag ["" name])) [[(~@ arg-names)] (~ g!output)]) (~ g!self)) + (exec (send ((~ (code;tag ["" name])) [[(~@ arg-names)] (~ g!output)]) (~ g!self)) (~ g!output)))))))) methods)] (wrap (list& (` (type: (~@ (common;gen-export-level _ex-lev)) (~ g!state-name) (~ state-type))) diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux index 31ddf804c..066384e11 100644 --- a/stdlib/source/lux/concurrency/stm.lux +++ b/stdlib/source/lux/concurrency/stm.lux @@ -13,7 +13,7 @@ [number "Nat/" Codec<Text,Nat>] text/format) [macro] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax]) (concurrency [atom #+ Atom atom] ["P" promise #+ Promise "Promise/" Monad<Promise>] diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux index 12e16655e..25e08a9f3 100644 --- a/stdlib/source/lux/control/comonad.lux +++ b/stdlib/source/lux/control/comonad.lux @@ -33,9 +33,9 @@ (square (head inputs)))))} (case tokens (#;Cons comonad (#;Cons [_ (#;Tuple bindings)] (#;Cons body #;Nil))) - (let [g!map (: AST [_cursor (#;Symbol ["" " map "])]) - g!split (: AST [_cursor (#;Symbol ["" " split "])]) - body' (fold (: (-> [AST AST] AST AST) + (let [g!map (: Code [_cursor (#;Symbol ["" " map "])]) + g!split (: Code [_cursor (#;Symbol ["" " split "])]) + body' (fold (: (-> [Code Code] Code Code) (function [binding body'] (let [[var value] binding] (case var diff --git a/stdlib/source/lux/control/cont.lux b/stdlib/source/lux/control/cont.lux index cbce3b70c..cbedc5df0 100644 --- a/stdlib/source/lux/control/cont.lux +++ b/stdlib/source/lux/control/cont.lux @@ -5,7 +5,7 @@ monad) function [macro #+ with-gensyms] - (macro [ast] + (macro [code] [syntax #+ syntax:]))) (type: #export (Cont i o) diff --git a/stdlib/source/lux/control/contract.lux b/stdlib/source/lux/control/contract.lux index d3523d564..941d4e1ef 100644 --- a/stdlib/source/lux/control/contract.lux +++ b/stdlib/source/lux/control/contract.lux @@ -3,7 +3,7 @@ (lux (control monad) (data text/format) [macro #+ Monad<Lux>] - (macro [ast] + (macro [code] ["s" syntax #+ syntax:]))) (def: #export (assert! message test) @@ -18,7 +18,7 @@ "Otherwise, an error is raised." (@pre (i.= 4 (i.+ 2 2)) (foo 123 456 789)))} - (wrap (list (` (exec (assert! (~ (ast;text (format "Pre-condition failed: " (%ast test)))) + (wrap (list (` (exec (assert! (~ (code;text (format "Pre-condition failed: " (%ast test)))) (~ test)) (~ expr)))))) @@ -32,6 +32,6 @@ (do @ [g!output (macro;gensym "")] (wrap (list (` (let [(~ g!output) (~ expr)] - (exec (assert! (~ (ast;text (format "Post-condition failed: " (%ast test)))) + (exec (assert! (~ (code;text (format "Post-condition failed: " (%ast test)))) ((~ test) (~ g!output))) (~ g!output)))))))) diff --git a/stdlib/source/lux/control/effect.lux b/stdlib/source/lux/control/effect.lux index 668b3a30e..0c867f4be 100644 --- a/stdlib/source/lux/control/effect.lux +++ b/stdlib/source/lux/control/effect.lux @@ -11,7 +11,7 @@ [ident "Ident/" Eq<Ident>] [text]) [macro] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax] (syntax [common])) [type])) @@ -79,8 +79,8 @@ (type: Op {#name Text - #inputs (List AST) - #output AST}) + #inputs (List Code) + #output Code}) (def: op^ (Syntax Op) @@ -106,16 +106,16 @@ (do @ [g!output (macro;gensym "g!output") #let [op-types (List/map (function [op] - (let [g!tag (ast;tag ["" (get@ #name op)]) + (let [g!tag (code;tag ["" (get@ #name op)]) g!inputs (` [(~@ (get@ #inputs op))]) g!output (` (-> (~ (get@ #output op)) (~ g!output)))] (` ((~ g!tag) (~ g!inputs) (~ g!output))))) ops) - type-name (ast;symbol ["" name]) + type-name (code;symbol ["" name]) type-def (` (type: (~@ (common;gen-export-level exp-lvl)) ((~ type-name) (~ g!output)) (~@ op-types))) - op-tags (List/map (|>. (get@ #name) [""] ast;tag (list) ast;tuple) + op-tags (List/map (|>. (get@ #name) [""] code;tag (list) code;tuple) ops) functor-def (` (struct: (~@ (common;gen-export-level exp-lvl)) (~' _) (F;Functor (~ type-name)) (def: ((~' map) (~' f) (~' fa)) @@ -126,16 +126,16 @@ ((~@ op-tags)))) )) function-defs (List/map (function [op] - (let [g!name (ast;symbol ["" (get@ #name op)]) - g!tag (ast;tag ["" (get@ #name op)]) - g!params (: (List AST) + (let [g!name (code;symbol ["" (get@ #name op)]) + g!tag (code;tag ["" (get@ #name op)]) + g!params (: (List Code) (case (list;size (get@ #inputs op)) +0 (list) s (|> (list;n.range +0 (n.dec s)) (List/map (|>. Nat/encode (format "_") [""] - ast;symbol)))))] + code;symbol)))))] (` (def: (~@ (common;gen-export-level exp-lvl)) ((~ g!name) (~@ g!params)) (-> (~@ (get@ #inputs op)) ((~ type-name) (~ (get@ #output op)))) @@ -147,8 +147,8 @@ (type: Translation {#effect Ident - #target-type AST - #target-monad AST}) + #target-type Code + #target-monad Code}) (def: translation^ (Syntax Translation) @@ -180,8 +180,8 @@ g!wrap (macro;gensym "wrap") #let [g!cases (|> defs (List/map (function [def] - (let [g!tag (ast;tag [e-module (get@ #common;def-name def)]) - g!args (List/map (|>. [""] ast;symbol) + (let [g!tag (code;tag [e-module (get@ #common;def-name def)]) + g!args (List/map (|>. [""] code;symbol) (get@ #common;def-args def)) eff-calc (case (get@ #common;def-type def) #;None @@ -202,8 +202,8 @@ ((~ g!wrap) ((~ g!cont) (~ g!value))))) )))) List/join)]] - (wrap (list (` (struct: (~@ (common;gen-export-level exp-lvl)) (~ (ast;symbol ["" name])) - (;;Handler (~ (ast;symbol effect)) (~ target-type)) + (wrap (list (` (struct: (~@ (common;gen-export-level exp-lvl)) (~ (code;symbol ["" name])) + (;;Handler (~ (code;symbol effect)) (~ target-type)) (def: (~' monad) (~ target-monad)) (def: ((~' handle) (~ g!input)) @@ -242,7 +242,7 @@ _ (error! (format "Wrong effect format: " (%type effect))))) -(def: g!functor AST (ast;symbol ["" "\t@E\t"])) +(def: g!functor Code (code;symbol ["" "\t@E\t"])) (syntax: #export (doE functor [bindings (s;tuple (s;some s;any))] body) {#;doc (doc "An alternative to the 'do' macro for monads." @@ -293,7 +293,7 @@ false)) (def: (nest-effect idx total base) - (-> Nat Nat AST AST) + (-> Nat Nat Code Code) (cond (n.= +0 idx) (` (+0 (~ base))) @@ -330,7 +330,7 @@ (same-effect? effect eff0)))) (#;Some [idx _])]) (wrap (list (` (#M;Effect (:: (~ g!functor) (~' map) (~' wrap) - (~ (nest-effect idx (list;size stack) (ast;symbol var)))))))) + (~ (nest-effect idx (list;size stack) (code;symbol var)))))))) _ (macro;fail (format "Invalid type to lift: " (%type output))))) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index 94cdf4dd5..66214f90c 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -4,7 +4,7 @@ (data [error #- fail] [text]) [macro] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax] (syntax [common])))) @@ -61,7 +61,7 @@ (exception: #export Some-Exception))} (do @ [current-module macro;current-module-name - #let [g!message (ast;symbol ["" "message"])]] - (wrap (list (` (def: (~@ (common;gen-export-level _ex-lev)) ((~ (ast;symbol ["" name])) (~ g!message)) + #let [g!message (code;symbol ["" "message"])]] + (wrap (list (` (def: (~@ (common;gen-export-level _ex-lev)) ((~ (code;symbol ["" name])) (~ g!message)) Exception - ($_ _Text/append_ "[" (~ (ast;text current-module)) ";" (~ (ast;text name)) "]\t" (~ g!message)))))))) + ($_ _Text/append_ "[" (~ (code;text current-module)) ";" (~ (code;text name)) "]\t" (~ g!message)))))))) diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux index 0fce26db0..9b908df9a 100644 --- a/stdlib/source/lux/control/monad.lux +++ b/stdlib/source/lux/control/monad.lux @@ -59,10 +59,10 @@ (wrap (f3 z))))} (case tokens (#;Cons monad (#;Cons [_ (#;Tuple bindings)] (#;Cons body #;Nil))) - (let [g!map (: AST [_cursor (#;Symbol ["" " map "])]) - g!join (: AST [_cursor (#;Symbol ["" " join "])]) - g!apply (: AST [_cursor (#;Symbol ["" " apply "])]) - body' (fold (: (-> [AST AST] AST AST) + (let [g!map (: Code [_cursor (#;Symbol ["" " map "])]) + g!join (: Code [_cursor (#;Symbol ["" " join "])]) + g!apply (: Code [_cursor (#;Symbol ["" " apply "])]) + body' (fold (: (-> [Code Code] Code Code) (function [binding body'] (let [[var value] binding] (case var diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux index fb0273835..67ef9da9c 100644 --- a/stdlib/source/lux/control/pipe.lux +++ b/stdlib/source/lux/control/pipe.lux @@ -5,12 +5,12 @@ maybe) [macro #+ with-gensyms Monad<Lux>] (macro ["s" syntax #+ syntax: Syntax] - [ast]) + [code]) )) ## [Syntax] (def: body^ - (Syntax (List AST)) + (Syntax (List Code)) (s;tuple (s;many s;any))) (syntax: #export (_> [tokens (s;at-least +2 s;any)]) @@ -38,7 +38,7 @@ (@> [(i.+ @ @)])))} (wrap (list (fold (function [next prev] (` (with-expansions - [(~ (ast;symbol ["" name])) (~ prev)] + [(~ (code;symbol ["" name])) (~ prev)] (~ next)))) prev body)))) diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux index fdef97988..958ef16df 100644 --- a/stdlib/source/lux/data/coll/list.lux +++ b/stdlib/source/lux/data/coll/list.lux @@ -333,7 +333,7 @@ ## [Syntax] (def: (symbol$ name) - (-> Text AST) + (-> Text Code) [["" +0 +0] (#;Symbol "" name)]) (macro: #export (zip tokens state) @@ -346,9 +346,9 @@ (if (n.> +0 num-lists) (let [(^open) Functor<List> indices (n.range +0 (n.dec num-lists)) - type-vars (: (List AST) (map (. symbol$ Nat/encode) indices)) + type-vars (: (List Code) (map (. symbol$ Nat/encode) indices)) zip-type (` (All [(~@ type-vars)] - (-> (~@ (map (: (-> AST AST) (function [var] (` (List (~ var))))) + (-> (~@ (map (: (-> Code Code) (function [var] (` (List (~ var))))) type-vars)) (List [(~@ type-vars)])))) vars+lists (|> indices @@ -392,10 +392,10 @@ indices (n.range +0 (n.dec num-lists)) g!return-type (symbol$ "\treturn-type\t") g!func (symbol$ "\tfunc\t") - type-vars (: (List AST) (map (. symbol$ Nat/encode) indices)) + type-vars (: (List Code) (map (. symbol$ Nat/encode) indices)) zip-type (` (All [(~@ type-vars) (~ g!return-type)] (-> (-> (~@ type-vars) (~ g!return-type)) - (~@ (map (: (-> AST AST) (function [var] (` (List (~ var))))) + (~@ (map (: (-> Code Code) (function [var] (` (List (~ var))))) type-vars)) (List (~ g!return-type))))) vars+lists (|> indices diff --git a/stdlib/source/lux/data/coll/ordered.lux b/stdlib/source/lux/data/coll/ordered.lux index c6fd5937f..47bf7cd65 100644 --- a/stdlib/source/lux/data/coll/ordered.lux +++ b/stdlib/source/lux/data/coll/ordered.lux @@ -7,7 +7,7 @@ ["p" product] ["M" maybe #+ Functor<Maybe>]) [macro] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax]))) (def: error-message Text "Invariant violation") diff --git a/stdlib/source/lux/data/coll/seq.lux b/stdlib/source/lux/data/coll/seq.lux index e72b9436d..1b55e3c41 100644 --- a/stdlib/source/lux/data/coll/seq.lux +++ b/stdlib/source/lux/data/coll/seq.lux @@ -10,7 +10,7 @@ [number] maybe) [macro] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax]))) (type: #export (Seq a) diff --git a/stdlib/source/lux/data/coll/tree/rose.lux b/stdlib/source/lux/data/coll/tree/rose.lux index 1f377fb70..979faa828 100644 --- a/stdlib/source/lux/data/coll/tree/rose.lux +++ b/stdlib/source/lux/data/coll/tree/rose.lux @@ -5,7 +5,7 @@ eq) (data (coll [list "L/" Monad<List>])) [macro] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax]))) ## [Types] @@ -30,11 +30,11 @@ #children children}) ## [Syntax] -(type: #rec Tree-AST - [AST (List Tree-AST)]) +(type: #rec Tree-Code + [Code (List Tree-Code)]) (def: tree^ - (Syntax Tree-AST) + (Syntax Tree-Code) (|> (|>. s;some s;record (s;seq s;any)) s;rec s;some diff --git a/stdlib/source/lux/data/coll/tree/zipper.lux b/stdlib/source/lux/data/coll/tree/zipper.lux index fd198a815..b217a0677 100644 --- a/stdlib/source/lux/data/coll/tree/zipper.lux +++ b/stdlib/source/lux/data/coll/tree/zipper.lux @@ -7,7 +7,7 @@ [stack #+ Stack]) [maybe "M/" Monad<Maybe>]) [macro] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax]))) ## Adapted from the clojure.zip namespace in the Clojure standard library. diff --git a/stdlib/source/lux/data/coll/vector.lux b/stdlib/source/lux/data/coll/vector.lux index 9d7bcba2c..5c17d53eb 100644 --- a/stdlib/source/lux/data/coll/vector.lux +++ b/stdlib/source/lux/data/coll/vector.lux @@ -13,7 +13,7 @@ [number "Int/" Number<Int>] [product]) [macro #+ with-gensyms] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax]) )) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 535de1b53..863c8cd3e 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -22,7 +22,7 @@ [dict #+ Dict])) [macro #+ Monad<Lux> with-gensyms] (macro [syntax #+ syntax:] - [ast] + [code] [poly #+ poly:]) [type] )) @@ -77,10 +77,10 @@ (^template [<ast-tag> <ctor> <json-tag>] [_ (<ast-tag> value)] (wrap (list (` (: JSON (<json-tag> (~ (<ctor> value)))))))) - ([#;Bool ast;bool #Boolean] - [#;Int (|>. int-to-real ast;real) #Number] - [#;Real ast;real #Number] - [#;Text ast;text #String]) + ([#;Bool code;bool #Boolean] + [#;Int (|>. int-to-real code;real) #Number] + [#;Real code;real #Number] + [#;Text code;text #String]) [_ (#;Tag ["" "null"])] (wrap (list (` (: JSON #Null)))) @@ -94,7 +94,7 @@ (function [[slot value]] (case slot [_ (#;Text key-name)] - (wrap (` [(~ (ast;text key-name)) (~ (wrapper value))])) + (wrap (` [(~ (code;text key-name)) (~ (wrapper value))])) _ (macro;fail "Wrong syntax for JSON object."))) @@ -709,8 +709,8 @@ ## [Syntax] (type: Shape - (#ArrayShape (List AST)) - (#ObjectShape (List [Text AST]))) + (#ArrayShape (List Code)) + (#ObjectShape (List [Text Code]))) (def: _shape^ (syntax;Syntax Shape) @@ -729,13 +729,13 @@ parsers (|> parts (list;zip2 (list;indices array-size)) (List/map (function [[idx parser]] - (` (nth (~ (ast;nat idx)) (~ parser))))))] + (` (nth (~ (code;nat idx)) (~ parser))))))] (wrap (list (` ($_ seq (~@ parsers)))))) (#ObjectShape kvs) (let [fields (List/map product;left kvs) parsers (List/map (function [[field-name parser]] - (` (field (~ (ast;text field-name)) (~ parser)))) + (` (field (~ (code;text field-name)) (~ parser)))) kvs)] (wrap (list (` ($_ seq (~@ parsers)))))) )) @@ -752,16 +752,16 @@ parsers (|> parts (list;zip2 (list;indices array-size)) (List/map (function [[idx parser]] - (` (nth (~ (ast;nat idx)) (~ parser))))))] - (wrap (list (` (ensure (array-size! (~ (ast;nat array-size))) + (` (nth (~ (code;nat idx)) (~ parser))))))] + (wrap (list (` (ensure (array-size! (~ (code;nat array-size))) ($_ seq (~@ parsers))))))) (#ObjectShape kvs) (let [fields (List/map product;left kvs) parsers (List/map (function [[field-name parser]] - (` (field (~ (ast;text field-name)) (~ parser)))) + (` (field (~ (code;text field-name)) (~ parser)))) kvs)] - (wrap (list (` (ensure (object-fields! (list (~@ (List/map ast;text fields)))) + (wrap (list (` (ensure (object-fields! (list (~@ (List/map code;text fields)))) ($_ seq (~@ parsers))))))) )) @@ -771,13 +771,13 @@ List/map) (poly: #hidden (Codec<JSON,?>//encode *env* :x:) - (let [->Codec//encode (: (-> AST AST) + (let [->Codec//encode (: (-> Code Code) (function [.type.] (` (-> (~ .type.) JSON))))] (with-expansions [<basic> (do-template [<type> <matcher> <encoder>] [(do @ [_ (<matcher> :x:)] (wrap (` (: (~ (->Codec//encode (` <type>))) <encoder>))))] - [Unit poly;unit (function [(~ (ast;symbol ["" "0"]))] #Null)] + [Unit poly;unit (function [(~ (code;symbol ["" "0"]))] #Null)] [Bool poly;bool ;;gen-boolean] [Int poly;int (|>. ;int-to-real ;;gen-number)] [Real poly;real ;;gen-number] @@ -839,10 +839,10 @@ pattern-matching (mapM @ (function [[name :case:]] (do @ - [#let [tag (ast;tag name)] + [#let [tag (code;tag name)] encoder (Codec<JSON,?>//encode new-*env* :case:)] (wrap (list (` ((~ tag) (~ g!case))) - (` (;;json [(~ (ast;text (product;right name))) + (` (;;json [(~ (code;text (product;right name))) ((~ encoder) (~ g!case))])))))) members) #let [:x:+ (case g!vars @@ -868,8 +868,8 @@ (function [[name :slot:]] (do @ [encoder (Codec<JSON,?>//encode new-*env* :slot:)] - (wrap [(` (~ (ast;text (product;right name)))) - (` ((~ encoder) (get@ (~ (ast;tag name)) (~ g!input))))]))) + (wrap [(` (~ (code;text (product;right name)))) + (` ((~ encoder) (get@ (~ (code;tag name)) (~ g!input))))]))) members) #let [:x:+ (case g!vars #;Nil @@ -881,7 +881,7 @@ (~ (->Codec//encode (` ((~ (type;to-ast :x:)) (~@ g!vars)))))))))]] (wrap (` (: (~ :x:+) (function [(~@ g!vars) (~ g!input)] - (;;json (~ (ast;record synthesis)))) + (;;json (~ (code;record synthesis)))) ))))) (with-gensyms [g!type-fun g!case] (do @ @@ -923,7 +923,7 @@ )))) (poly: #hidden (Codec<JSON,?>//decode *env* :x:) - (let [->Codec//decode (: (-> AST AST) + (let [->Codec//decode (: (-> Code Code) (function [.type.] (` (-> JSON (Error (~ .type.))))))] (with-expansions [<basic> (do-template [<type> <matcher> <decoder>] @@ -992,10 +992,10 @@ pattern-matching (mapM @ (function [[name :case:]] (do @ - [#let [tag (ast;tag name)] + [#let [tag (code;tag name)] decoder (Codec<JSON,?>//decode new-*env* :case:)] (wrap (list (` (do Monad<Parser> - [(~ g!_) (;;nth +0 (;;text! (~ (ast;text (product;right name))))) + [(~ g!_) (;;nth +0 (;;text! (~ (code;text (product;right name))))) (~ g!_) (;;nth +1 (~ decoder))] ((~ (' wrap)) ((~ tag) (~ g!_))))))))) members) @@ -1026,10 +1026,10 @@ extraction (mapM @ (function [[name :slot:]] (do @ - [#let [g!member (ast;symbol ["" (product;right name)])] + [#let [g!member (code;symbol ["" (product;right name)])] decoder (Codec<JSON,?>//decode new-*env* :slot:)] (wrap (list g!member - (` (;;get (~ (ast;text (product;right name))) (~ g!input))) + (` (;;get (~ (code;text (product;right name))) (~ g!input))) g!member (` ((~ decoder) (~ g!member))))))) members) @@ -1045,8 +1045,8 @@ (function [(~@ g!vars) (~ g!input)] (do Monad<Error> [(~@ (List/join extraction))] - ((~ (' wrap)) (~ (ast;record (List/map (function [[name :slot:]] - [(ast;tag name) (ast;symbol ["" (product;right name)])]) + ((~ (' wrap)) (~ (code;record (List/map (function [[name :slot:]] + [(code;tag name) (code;symbol ["" (product;right name)])]) members)))))) ))))) (with-gensyms [g!type-fun g!case g!input] diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index 8b7b21400..5f002e9df 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -12,7 +12,7 @@ maybe (coll [list "List/" Monad<List>])) [macro] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax]))) ## Based on org.apache.commons.math4.complex.Complex diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux index 40b909c80..b5cc0e4b2 100644 --- a/stdlib/source/lux/data/number/ratio.lux +++ b/stdlib/source/lux/data/number/ratio.lux @@ -12,7 +12,7 @@ error [product]) [macro] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax]))) (type: #export Ratio diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index 9a1c56188..5e62382f0 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -9,7 +9,7 @@ (coll [list "" Monad<List>])) [type] [macro] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax]))) ## [Syntax] @@ -35,16 +35,16 @@ [%b Bool (:: bool;Codec<Text,Bool> encode)] [%n Nat (:: number;Codec<Text,Nat> encode)] [%i Int (:: number;Codec<Text,Int> encode)] - [%d Deg (:: number;Codec<Text,Deg> encode)] + [%d Deg (:: number;Codec<Text,Deg> encode)] [%r Real (:: number;Codec<Text,Real> encode)] [%c Char (:: char;Codec<Text,Char> encode)] [%t Text (:: text;Codec<Text,Text> encode)] [%ident Ident (:: ident;Codec<Text,Ident> encode)] - [%ast AST ast;to-text] + [%ast Code code;to-text] [%type Type type;to-text] - [%bin Nat (:: number;Binary@Codec<Text,Nat> encode)] - [%oct Nat (:: number;Octal@Codec<Text,Nat> encode)] - [%hex Nat (:: number;Hex@Codec<Text,Nat> encode)] + [%bin Nat (:: number;Binary@Codec<Text,Nat> encode)] + [%oct Nat (:: number;Octal@Codec<Text,Nat> encode)] + [%hex Nat (:: number;Hex@Codec<Text,Nat> encode)] ) (def: #export (%list formatter) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index 231dfaddf..34fdc36fa 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -9,7 +9,7 @@ [product] (coll [list "" Fold<List> "List/" Monad<List>])) [macro #- run] - (macro [ast] + (macro [code] ["s" syntax #+ syntax:]))) ## [Utils] @@ -83,39 +83,39 @@ (&;seq (wrap "") identifier-part^)))) (def: (re-var^ current-module) - (-> Text (Lexer AST)) + (-> Text (Lexer Code)) (do Monad<Lexer> [ident (&;enclosed ["\\@<" ">"] (identifier^ current-module))] - (wrap (` (: (Lexer Text) (~ (ast;symbol ident))))))) + (wrap (` (: (Lexer Text) (~ (code;symbol ident))))))) (def: re-char-range^ - (Lexer AST) + (Lexer Code) (do Monad<Lexer> [from regex-char^ _ (&;char #"-") to regex-char^] - (wrap (` (&;char-range (~ (ast;char from)) (~ (ast;char to))))))) + (wrap (` (&;char-range (~ (code;char from)) (~ (code;char to))))))) (def: re-char^ - (Lexer AST) + (Lexer Code) (do Monad<Lexer> [char escaped-char^] - (wrap (` (&;char (~ (ast;char char))))))) + (wrap (` (&;char (~ (code;char char))))))) (def: re-char+^ - (Lexer AST) + (Lexer Code) (do Monad<Lexer> [base re-char^] (wrap (` (->Text (~ base)))))) (def: re-char-options^ - (Lexer AST) + (Lexer Code) (do Monad<Lexer> [options (&;many' escaped-char^)] - (wrap (` (&;one-of (~ (ast;text options))))))) + (wrap (` (&;one-of (~ (code;text options))))))) (def: re-user-class^' - (Lexer AST) + (Lexer Code) (do Monad<Lexer> [negate? (&;opt (&;char #"^")) parts (&;many ($_ &;either @@ -126,7 +126,7 @@ #;None (` (->Text ($_ &;either (~@ parts)))))))) (def: re-user-class^ - (Lexer AST) + (Lexer Code) (do Monad<Lexer> [_ (wrap []) init re-user-class^' @@ -163,7 +163,7 @@ (&;char #"\u0020"))) (def: re-system-class^ - (Lexer AST) + (Lexer Code) (do Monad<Lexer> [] ($_ &;either @@ -192,7 +192,7 @@ ))) (def: re-class^ - (Lexer AST) + (Lexer Code) (&;either re-system-class^ (&;enclosed ["[" "]"] re-user-class^))) @@ -201,19 +201,19 @@ (&;codec number;Codec<Text,Int> (&;many' &;digit))) (def: re-back-reference^ - (Lexer AST) + (Lexer Code) (&;either (do Monad<Lexer> [_ (&;char #"\\") id int^] - (wrap (` (&;text (~ (ast;symbol ["" (Int/encode id)])))))) + (wrap (` (&;text (~ (code;symbol ["" (Int/encode id)])))))) (do Monad<Lexer> [_ (&;text "\\k<") captured-name identifier-part^ _ (&;text ">")] - (wrap (` (&;text (~ (ast;symbol ["" captured-name])))))))) + (wrap (` (&;text (~ (code;symbol ["" captured-name])))))))) (def: (re-simple^ current-module) - (-> Text (Lexer AST)) + (-> Text (Lexer Code)) ($_ &;either re-class^ (re-var^ current-module) @@ -222,7 +222,7 @@ )) (def: (re-simple-quantified^ current-module) - (-> Text (Lexer AST)) + (-> Text (Lexer Code)) (do Monad<Lexer> [base (re-simple^ current-module) quantifier (&;one-of "?*+")] @@ -238,33 +238,33 @@ ))) (def: (re-counted-quantified^ current-module) - (-> Text (Lexer AST)) + (-> Text (Lexer Code)) (do Monad<Lexer> [base (re-simple^ current-module)] (&;enclosed ["{" "}"] ($_ &;either (do @ [[from to] (&;seq int^ (&;after (&;char #",") int^))] - (wrap (` (join-text^ (&;between (~ (ast;nat (int-to-nat from))) - (~ (ast;nat (int-to-nat to))) + (wrap (` (join-text^ (&;between (~ (code;nat (int-to-nat from))) + (~ (code;nat (int-to-nat to))) (~ base)))))) (do @ [limit (&;after (&;char #",") int^)] - (wrap (` (join-text^ (&;at-most (~ (ast;nat (int-to-nat limit))) (~ base)))))) + (wrap (` (join-text^ (&;at-most (~ (code;nat (int-to-nat limit))) (~ base)))))) (do @ [limit (&;before (&;char #",") int^)] - (wrap (` (join-text^ (&;at-least (~ (ast;nat (int-to-nat limit))) (~ base)))))) + (wrap (` (join-text^ (&;at-least (~ (code;nat (int-to-nat limit))) (~ base)))))) (do @ [limit int^] - (wrap (` (join-text^ (&;exactly (~ (ast;nat (int-to-nat limit))) (~ base)))))))))) + (wrap (` (join-text^ (&;exactly (~ (code;nat (int-to-nat limit))) (~ base)))))))))) (def: (re-quantified^ current-module) - (-> Text (Lexer AST)) + (-> Text (Lexer Code)) (&;either (re-simple-quantified^ current-module) (re-counted-quantified^ current-module))) (def: (re-complex^ current-module) - (-> Text (Lexer AST)) + (-> Text (Lexer Code)) ($_ &;either (re-quantified^ current-module) (re-simple^ current-module))) @@ -279,17 +279,17 @@ (def: (re-sequential^ capturing? re-scoped^ current-module) (-> Bool - (-> Text (Lexer [Re-Group AST])) + (-> Text (Lexer [Re-Group Code])) Text - (Lexer [Nat AST])) + (Lexer [Nat Code])) (do Monad<Lexer> [parts (&;many (&;alt (re-complex^ current-module) (re-scoped^ current-module))) - #let [g!total (ast;symbol ["" "0total"]) - g!temp (ast;symbol ["" "0temp"]) - [_ names steps] (fold (: (-> (Either AST [Re-Group AST]) - [Int (List AST) (List (List AST))] - [Int (List AST) (List (List AST))]) + #let [g!total (code;symbol ["" "0total"]) + g!temp (code;symbol ["" "0temp"]) + [_ names steps] (fold (: (-> (Either Code [Re-Group Code]) + [Int (List Code) (List (List Code))] + [Int (List Code) (List (List Code))]) (function [part [idx names steps]] (case part (^or (#;Left complex) (#;Right [#Non-Capturing complex])) @@ -302,10 +302,10 @@ (#;Right [(#Capturing [?name num-captures]) scoped]) (let [[idx! name!] (case ?name (#;Some _name) - [idx (ast;symbol ["" _name])] + [idx (code;symbol ["" _name])] #;None - [(i.inc idx) (ast;symbol ["" (Int/encode idx)])]) + [(i.inc idx) (code;symbol ["" (Int/encode idx)])]) access (if (n.> +0 num-captures) (` (product;left (~ name!))) name!)] @@ -316,8 +316,8 @@ steps)]) ))) [0 - (: (List AST) (list)) - (: (List (List AST)) (list))] + (: (List Code) (list)) + (: (List (List Code)) (list))] parts)]] (wrap [(if capturing? (list;size names) @@ -363,16 +363,16 @@ (#;Left error))))) (def: (prep-alternative [num-captures alt]) - (-> [Nat AST] AST) + (-> [Nat Code] Code) (if (n.> +0 num-captures) alt (` (unflatten^ (~ alt))))) (def: (re-alternative^ capturing? re-scoped^ current-module) (-> Bool - (-> Text (Lexer [Re-Group AST])) + (-> Text (Lexer [Re-Group Code])) Text - (Lexer [Nat AST])) + (Lexer [Nat Code])) (do Monad<Lexer> [#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)] head sub^ @@ -386,7 +386,7 @@ (` ($_ (~ g!op) (~ (prep-alternative head)) (~@ (List/map prep-alternative tail))))])))) (def: (re-scoped^ current-module) - (-> Text (Lexer [Re-Group AST])) + (-> Text (Lexer [Re-Group Code])) ($_ &;either (do Monad<Lexer> [_ (&;text "(?:") @@ -410,7 +410,7 @@ (wrap [(#Capturing [#;None num-captures]) pattern])))) (def: (regex^ current-module) - (-> Text (Lexer AST)) + (-> Text (Lexer Code)) (:: Monad<Lexer> map product;right (re-alternative^ true re-scoped^ current-module))) ## [Syntax] @@ -502,7 +502,7 @@ (do @ [g!temp (macro;gensym "temp")] (wrap (list& (` (^=> (~ g!temp) - [(&;run (~ g!temp) (regex (~ (ast;text pattern)))) + [(&;run (~ g!temp) (regex (~ (code;text pattern)))) (#;Right (~ (default g!temp bindings)))])) body diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux index 39e15f780..0da2a2587 100644 --- a/stdlib/source/lux/host.js.lux +++ b/stdlib/source/lux/host.js.lux @@ -3,7 +3,7 @@ (lux (control monad) (data (coll [list #* "L/" Fold<List>])) [macro #+ with-gensyms] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax]) )) @@ -56,7 +56,7 @@ (ref "document") (ref "Math.ceil" (-> Real Real)))} (wrap (list (` (:! (~ (default (' ;;Object) type)) - (;_lux_proc ["js" "ref"] [(~ (ast;text name))])))))) + (;_lux_proc ["js" "ref"] [(~ (code;text name))])))))) (do-template [<name> <proc> <doc>] [(syntax: #export (<name>) @@ -80,4 +80,4 @@ (#;Right [object field args ?type]) (wrap (list (` (:! (~ (default (' ;;Object) ?type)) - (;_lux_proc ["js" "object-call"] [(~ object) (~ (ast;text field)) (~@ args)]))))))) + (;_lux_proc ["js" "object-call"] [(~ object) (~ (code;text field)) (~@ args)]))))))) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 96853e6f5..c72a683d1 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -12,7 +12,7 @@ text/format [bool "Bool/" Codec<Text,Bool>]) [macro #+ with-gensyms Functor<Lux> Monad<Lux>] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax]) [type] )) @@ -78,7 +78,7 @@ ["[C" Char-Array] ) -(type: Code Text) +(type: JVM-Code Text) (type: BoundKind #UpperBound @@ -129,7 +129,7 @@ #super-class-params (List GenericType)}) (type: AnnotationParam - [Text AST]) + [Text Code]) (type: Annotation {#ann-name Text @@ -141,7 +141,7 @@ #member-anns (List Annotation)}) (type: FieldDecl - (#ConstantField GenericType AST) + (#ConstantField GenericType Code) (#VariableField StateModifier GenericType)) (type: MethodDecl @@ -155,34 +155,34 @@ #arg-type GenericType}) (type: ConstructorArg - [GenericType AST]) + [GenericType Code]) (type: MethodDef (#ConstructorMethod [Bool (List TypeParam) (List ArgDecl) (List ConstructorArg) - AST + Code (List GenericType)]) (#VirtualMethod [Bool Bool (List TypeParam) (List ArgDecl) GenericType - AST + Code (List GenericType)]) (#OverridenMethod [Bool ClassDecl (List TypeParam) (List ArgDecl) GenericType - AST + Code (List GenericType)]) (#StaticMethod [Bool (List TypeParam) (List ArgDecl) GenericType - AST + Code (List GenericType)]) (#AbstractMethod [(List TypeParam) (List ArgDecl) @@ -194,8 +194,8 @@ (List GenericType)])) (type: PartialCall - {#pc-method AST - #pc-args AST}) + {#pc-method Code + #pc-args Code}) (type: ImportMethodKind #StaticIMK @@ -246,7 +246,7 @@ name)) (def: (manual-primitive-to-type class) - (-> Text (Maybe AST)) + (-> Text (Maybe Code)) (case class (^template [<prim> <type>] <prim> @@ -265,7 +265,7 @@ #;None)) (def: (auto-primitive-to-type class) - (-> Text (Maybe AST)) + (-> Text (Maybe Code)) (case class (^template [<prim> <type>] <prim> @@ -286,8 +286,8 @@ (def: (generic-class->type' mode type-params in-array? name+params class->type') (-> Primitive-Mode (List TypeParam) Bool [Text (List GenericType)] - (-> Primitive-Mode (List TypeParam) Bool GenericType AST) - AST) + (-> Primitive-Mode (List TypeParam) Bool GenericType Code) + Code) (case [name+params mode in-array?] (^=> [[prim #;Nil] #ManualPrM false] [(manual-primitive-to-type prim) (#;Some output)]) @@ -299,10 +299,10 @@ [[name params] _ _] (let [=params (map (class->type' mode type-params in-array?) params)] - (` (host (~ (ast;symbol ["" name])) [(~@ =params)]))))) + (` (host (~ (code;symbol ["" name])) [(~@ =params)]))))) (def: (class->type' mode type-params in-array? class) - (-> Primitive-Mode (List TypeParam) Bool GenericType AST) + (-> Primitive-Mode (List TypeParam) Bool GenericType Code) (case class (#GenericTypeVar name) (case (find (function [[pname pbounds]] @@ -310,7 +310,7 @@ (not (list;empty? pbounds)))) type-params) #;None - (ast;symbol ["" name]) + (code;symbol ["" name]) (#;Some [pname pbounds]) (class->type' mode type-params in-array? (default (undefined) (list;head pbounds)))) @@ -321,7 +321,7 @@ (#GenericArray param) (let [=param (class->type' mode type-params true param)] - (` (host (~ (ast;symbol ["" array-type-name])) [(~ =param)]))) + (` (host (~ (code;symbol ["" array-type-name])) [(~ =param)]))) (^or (#GenericWildcard #;None) (#GenericWildcard (#;Some [#LowerBound _]))) (' (;Ex [*] *)) @@ -331,25 +331,25 @@ )) (def: (class->type mode type-params class) - (-> Primitive-Mode (List TypeParam) GenericType AST) + (-> Primitive-Mode (List TypeParam) GenericType Code) (class->type' mode type-params false class)) (def: (type-param-type$ [name bounds]) - (-> TypeParam AST) - (ast;symbol ["" name])) + (-> TypeParam Code) + (code;symbol ["" name])) (def: (class-decl-type$ (^slots [#class-name #class-params])) - (-> ClassDecl AST) - (let [=params (map (: (-> TypeParam AST) + (-> ClassDecl Code) + (let [=params (map (: (-> TypeParam Code) (function [[pname pbounds]] (case pbounds #;Nil - (ast;symbol ["" pname]) + (code;symbol ["" pname]) (#;Cons bound1 _) (class->type #ManualPrM class-params bound1)))) class-params)] - (` (host (~ (ast;symbol ["" class-name])) [(~@ =params)])))) + (` (host (~ (code;symbol ["" class-name])) [(~@ =params)])))) (def: empty-imports ClassImports @@ -530,29 +530,29 @@ )) (def: (make-get-const-parser class-name field-name) - (-> Text Text (Syntax AST)) + (-> Text Text (Syntax Code)) (do s;Monad<Syntax> [#let [dotted-name (format "." field-name)] - _ (s;this! (ast;symbol ["" dotted-name]))] - (wrap (`' (_lux_proc ["jvm" (~ (ast;text (format "getstatic" ":" class-name ":" field-name)))] []))))) + _ (s;this! (code;symbol ["" dotted-name]))] + (wrap (`' (_lux_proc ["jvm" (~ (code;text (format "getstatic" ":" class-name ":" field-name)))] []))))) (def: (make-get-var-parser class-name field-name) - (-> Text Text (Syntax AST)) + (-> Text Text (Syntax Code)) (do s;Monad<Syntax> [#let [dotted-name (format "." field-name)] - _ (s;this! (ast;symbol ["" dotted-name]))] - (wrap (`' (_lux_proc ["jvm" (~ (ast;text (format "getfield" ":" class-name ":" field-name)))] [_jvm_this]))))) + _ (s;this! (code;symbol ["" dotted-name]))] + (wrap (`' (_lux_proc ["jvm" (~ (code;text (format "getfield" ":" class-name ":" field-name)))] [_jvm_this]))))) (def: (make-put-var-parser class-name field-name) - (-> Text Text (Syntax AST)) + (-> Text Text (Syntax Code)) (do s;Monad<Syntax> [#let [dotted-name (format "." field-name)] - [_ _ value] (: (Syntax [Unit Unit AST]) - (s;form ($_ s;seq (s;this! (' :=)) (s;this! (ast;symbol ["" dotted-name])) s;any)))] - (wrap (`' (_lux_proc ["jvm" (~ (ast;text (format "putfield" ":" class-name ":" field-name)))] [_jvm_this (~ value)]))))) + [_ _ value] (: (Syntax [Unit Unit Code]) + (s;form ($_ s;seq (s;this! (' :=)) (s;this! (code;symbol ["" dotted-name])) s;any)))] + (wrap (`' (_lux_proc ["jvm" (~ (code;text (format "putfield" ":" class-name ":" field-name)))] [_jvm_this (~ value)]))))) (def: (pre-walk-replace f input) - (-> (-> AST AST) AST AST) + (-> (-> Code Code) Code Code) (case (f input) (^template [<tag>] [meta (<tag> parts)] @@ -561,7 +561,7 @@ [#;Tuple]) [meta (#;Record pairs)] - [meta (#;Record (map (: (-> [AST AST] [AST AST]) + [meta (#;Record (map (: (-> [Code Code] [Code Code]) (function [[key val]] [(pre-walk-replace f key) (pre-walk-replace f val)])) pairs))] @@ -570,7 +570,7 @@ ast')) (def: (parser->replacer p ast) - (-> (Syntax AST) (-> AST AST)) + (-> (Syntax Code) (-> Code Code)) (case (s;run (list ast) p) (#;Right [#;Nil ast']) ast' @@ -580,7 +580,7 @@ )) (def: (field->parser class-name [[field-name _ _] field]) - (-> Text [MemberDecl FieldDecl] (Syntax AST)) + (-> Text [MemberDecl FieldDecl] (Syntax Code)) (case field (#ConstantField _) (make-get-const-parser class-name field-name) @@ -590,33 +590,33 @@ (make-put-var-parser class-name field-name)))) (def: (make-constructor-parser params class-name arg-decls) - (-> (List TypeParam) Text (List ArgDecl) (Syntax AST)) + (-> (List TypeParam) Text (List ArgDecl) (Syntax Code)) (do s;Monad<Syntax> - [[_ args] (: (Syntax [Unit (List AST)]) + [[_ args] (: (Syntax [Unit (List Code)]) (s;form ($_ s;seq (s;this! (' .new!)) (s;tuple (s;exactly (list;size arg-decls) s;any))))) #let [arg-decls' (: (List Text) (map (. (simple-class$ params) product;right) arg-decls))]] - (wrap (` (;_lux_proc ["jvm" (~ (ast;text (format "new" ":" class-name ":" (text;join-with "," arg-decls'))))] + (wrap (` (;_lux_proc ["jvm" (~ (code;text (format "new" ":" class-name ":" (text;join-with "," arg-decls'))))] [(~@ args)]))))) (def: (make-static-method-parser params class-name method-name arg-decls) - (-> (List TypeParam) Text Text (List ArgDecl) (Syntax AST)) + (-> (List TypeParam) Text Text (List ArgDecl) (Syntax Code)) (do s;Monad<Syntax> [#let [dotted-name (format "." method-name "!")] - [_ args] (: (Syntax [Unit (List AST)]) - (s;form ($_ s;seq (s;this! (ast;symbol ["" dotted-name])) (s;tuple (s;exactly (list;size arg-decls) s;any))))) + [_ args] (: (Syntax [Unit (List Code)]) + (s;form ($_ s;seq (s;this! (code;symbol ["" dotted-name])) (s;tuple (s;exactly (list;size arg-decls) s;any))))) #let [arg-decls' (: (List Text) (map (. (simple-class$ params) product;right) arg-decls))]] - (wrap (`' (;_lux_proc ["jvm" (~ (ast;text (format "invokestatic" ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))] + (wrap (`' (;_lux_proc ["jvm" (~ (code;text (format "invokestatic" ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))] [(~@ args)]))))) (do-template [<name> <jvm-op>] [(def: (<name> params class-name method-name arg-decls) - (-> (List TypeParam) Text Text (List ArgDecl) (Syntax AST)) + (-> (List TypeParam) Text Text (List ArgDecl) (Syntax Code)) (do s;Monad<Syntax> [#let [dotted-name (format "." method-name "!")] - [_ args] (: (Syntax [Unit (List AST)]) - (s;form ($_ s;seq (s;this! (ast;symbol ["" dotted-name])) (s;tuple (s;exactly (list;size arg-decls) s;any))))) + [_ args] (: (Syntax [Unit (List Code)]) + (s;form ($_ s;seq (s;this! (code;symbol ["" dotted-name])) (s;tuple (s;exactly (list;size arg-decls) s;any))))) #let [arg-decls' (: (List Text) (map (. (simple-class$ params) product;right) arg-decls))]] - (wrap (`' (;_lux_proc ["jvm" (~ (ast;text (format <jvm-op> ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))] + (wrap (`' (;_lux_proc ["jvm" (~ (code;text (format <jvm-op> ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))] [(~' _jvm_this) (~@ args)])))))] [make-special-method-parser "invokespecial"] @@ -624,7 +624,7 @@ ) (def: (method->parser params class-name [[method-name _ _] meth-def]) - (-> (List TypeParam) Text [MemberDecl MethodDef] (Syntax AST)) + (-> (List TypeParam) Text [MemberDecl MethodDef] (Syntax Code)) (case meth-def (#ConstructorMethod strict? type-vars args constructor-args return-expr exs) (make-constructor-parser params class-name args) @@ -1072,19 +1072,19 @@ ## Generators (def: with-parens - (-> Code Code) + (-> JVM-Code JVM-Code) (text;enclose ["(" ")"])) (def: with-brackets - (-> Code Code) + (-> JVM-Code JVM-Code) (text;enclose ["[" "]"])) (def: spaced - (-> (List Code) Code) + (-> (List JVM-Code) JVM-Code) (text;join-with " ")) (def: (privacy-modifier$ pm) - (-> PrivacyModifier Code) + (-> PrivacyModifier JVM-Code) (case pm #PublicPM "public" #PrivatePM "private" @@ -1092,28 +1092,28 @@ #DefaultPM "default")) (def: (inheritance-modifier$ im) - (-> InheritanceModifier Code) + (-> InheritanceModifier JVM-Code) (case im #FinalIM "final" #AbstractIM "abstract" #DefaultIM "default")) (def: (annotation-param$ [name value]) - (-> AnnotationParam Code) - (format name "=" (ast;to-text value))) + (-> AnnotationParam JVM-Code) + (format name "=" (code;to-text value))) (def: (annotation$ [name params]) - (-> Annotation Code) + (-> Annotation JVM-Code) (format "(" name " " "{" (text;join-with "\t" (map annotation-param$ params)) "}" ")")) (def: (bound-kind$ kind) - (-> BoundKind Code) + (-> BoundKind JVM-Code) (case kind #UpperBound "<" #LowerBound ">")) (def: (generic-type$ gtype) - (-> GenericType Code) + (-> GenericType JVM-Code) (case gtype (#GenericTypeVar name) name @@ -1131,19 +1131,19 @@ (format (bound-kind$ bound-kind) (generic-type$ bound)))) (def: (type-param$ [name bounds]) - (-> TypeParam Code) + (-> TypeParam JVM-Code) (format "(" name " " (spaced (map generic-type$ bounds)) ")")) (def: (class-decl$ (^open)) - (-> ClassDecl Code) + (-> ClassDecl JVM-Code) (format "(" class-name " " (spaced (map type-param$ class-params)) ")")) (def: (super-class-decl$ (^slots [#super-class-name #super-class-params])) - (-> SuperClassDecl Code) + (-> SuperClassDecl JVM-Code) (format "(" super-class-name " " (spaced (map generic-type$ super-class-params)) ")")) (def: (method-decl$ [[name pm anns] method-decl]) - (-> [MemberDecl MethodDecl] Code) + (-> [MemberDecl MethodDecl] JVM-Code) (let [(^slots [#method-tvars #method-inputs #method-output #method-exs]) method-decl] (with-parens (spaced (list name @@ -1155,21 +1155,21 @@ )))) (def: (state-modifier$ sm) - (-> StateModifier Code) + (-> StateModifier JVM-Code) (case sm #VolatileSM "volatile" #FinalSM "final" #DefaultSM "default")) (def: (field-decl$ [[name pm anns] field]) - (-> [MemberDecl FieldDecl] Code) + (-> [MemberDecl FieldDecl] JVM-Code) (case field (#ConstantField class value) (with-parens (spaced (list "constant" name (with-brackets (spaced (map annotation$ anns))) (generic-type$ class) - (ast;to-text value)) + (code;to-text value)) )) (#VariableField sm class) @@ -1183,17 +1183,17 @@ )) (def: (arg-decl$ [name type]) - (-> ArgDecl Code) + (-> ArgDecl JVM-Code) (with-parens (spaced (list name (generic-type$ type))))) (def: (constructor-arg$ [class term]) - (-> ConstructorArg Code) + (-> ConstructorArg JVM-Code) (with-brackets - (spaced (list (generic-type$ class) (ast;to-text term))))) + (spaced (list (generic-type$ class) (code;to-text term))))) (def: (method-def$ replacer super-class [[name pm anns] method-def]) - (-> (-> AST AST) SuperClassDecl [MemberDecl MethodDef] Code) + (-> (-> Code Code) SuperClassDecl [MemberDecl MethodDef] JVM-Code) (case method-def (#ConstructorMethod strict-fp? type-vars arg-decls constructor-args body exs) (with-parens @@ -1205,7 +1205,7 @@ (with-brackets (spaced (map generic-type$ exs))) (with-brackets (spaced (map arg-decl$ arg-decls))) (with-brackets (spaced (map constructor-arg$ constructor-args))) - (ast;to-text (pre-walk-replace replacer body)) + (code;to-text (pre-walk-replace replacer body)) ))) (#VirtualMethod final? strict-fp? type-vars arg-decls return-type body exs) @@ -1220,7 +1220,7 @@ (with-brackets (spaced (map generic-type$ exs))) (with-brackets (spaced (map arg-decl$ arg-decls))) (generic-type$ return-type) - (ast;to-text (pre-walk-replace replacer body))))) + (code;to-text (pre-walk-replace replacer body))))) (#OverridenMethod strict-fp? class-decl type-vars arg-decls return-type body exs) (let [super-replacer (parser->replacer (s;form (do s;Monad<Syntax> @@ -1228,7 +1228,7 @@ args (s;tuple (s;exactly (list;size arg-decls) s;any)) #let [arg-decls' (: (List Text) (map (. (simple-class$ (list)) product;right) arg-decls))]] - (wrap (`' (;_lux_proc ["jvm" (~ (ast;text (format "invokespecial" ":" (get@ #super-class-name super-class) ":" name ":" (text;join-with "," arg-decls'))))] + (wrap (`' (;_lux_proc ["jvm" (~ (code;text (format "invokespecial" ":" (get@ #super-class-name super-class) ":" name ":" (text;join-with "," arg-decls'))))] [(~' _jvm_this) (~@ args)]))))))] (with-parens (spaced (list "override" @@ -1243,7 +1243,7 @@ (|> body (pre-walk-replace replacer) (pre-walk-replace super-replacer) - (ast;to-text)) + (code;to-text)) )))) (#StaticMethod strict-fp? type-vars arg-decls return-type body exs) @@ -1257,7 +1257,7 @@ (with-brackets (spaced (map generic-type$ exs))) (with-brackets (spaced (map arg-decl$ arg-decls))) (generic-type$ return-type) - (ast;to-text (pre-walk-replace replacer body))))) + (code;to-text (pre-walk-replace replacer body))))) (#AbstractMethod type-vars arg-decls return-type exs) (with-parens @@ -1283,7 +1283,7 @@ )) (def: (complete-call$ obj [method args]) - (-> AST PartialCall AST) + (-> Code PartialCall Code) (` ((~ method) (~ args) (~ obj)))) ## [Syntax] @@ -1375,7 +1375,7 @@ (with-brackets (spaced (map annotation$ annotations))) (with-brackets (spaced (map field-decl$ fields))) (with-brackets (spaced (map (method-def$ replacer super) methods))))))]] - (wrap (list (` (;_lux_proc ["jvm" (~ (ast;text def-code))] [])))))) + (wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] [])))))) (syntax: #export (interface: [#let [imports (class-imports *compiler*)]] [class-decl (class-decl^ imports)] @@ -1395,7 +1395,7 @@ (with-brackets (spaced (map super-class-decl$ supers))) (with-brackets (spaced (map annotation$ annotations))) (spaced (map method-decl$ members)))))] - (wrap (list (` (;_lux_proc ["jvm" (~ (ast;text def-code))] [])))) + (wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] [])))) )) (syntax: #export (object [#let [imports (class-imports *compiler*)]] @@ -1421,7 +1421,7 @@ (with-brackets (spaced (map super-class-decl$ interfaces))) (with-brackets (spaced (map constructor-arg$ constructor-args))) (with-brackets (spaced (map (method-def$ id super) methods))))))] - (wrap (list (` (;_lux_proc ["jvm" (~ (ast;text def-code))] [])))))) + (wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] [])))))) (syntax: #export (null) {#;doc (doc "Null object reference." @@ -1486,14 +1486,14 @@ (instance? String "YOLO"))} (case obj (#;Some obj) - (wrap (list (` (;_lux_proc ["jvm" (~ (ast;text (format "instanceof" ":" (simple-class$ (list) class))))] [(~ obj)])))) + (wrap (list (` (;_lux_proc ["jvm" (~ (code;text (format "instanceof" ":" (simple-class$ (list) class))))] [(~ obj)])))) #;None (do @ [g!obj (macro;gensym "obj")] (wrap (list (` (: (-> (host (~' java.lang.Object)) Bool) (function [(~ g!obj)] - (;_lux_proc ["jvm" (~ (ast;text (format "instanceof" ":" (simple-class$ (list) class))))] [(~ g!obj)]))))))) + (;_lux_proc ["jvm" (~ (code;text (format "instanceof" ":" (simple-class$ (list) class))))] [(~ g!obj)]))))))) )) (syntax: #export (synchronized lock body) @@ -1530,26 +1530,26 @@ (~ g!obj)))))))) (def: (class-import$ long-name? [full-name params]) - (-> Bool ClassDecl AST) + (-> Bool ClassDecl Code) (let [def-name (if long-name? full-name (short-class-name full-name))] (case params #;Nil - (` (def: (~ (ast;symbol ["" def-name])) + (` (def: (~ (code;symbol ["" def-name])) {#;type? true - #;;jvm-class (~ (ast;text full-name))} + #;;jvm-class (~ (code;text full-name))} Type - (host (~ (ast;symbol ["" full-name]))))) + (host (~ (code;symbol ["" full-name]))))) (#;Cons _) - (let [params' (map (function [[p _]] (ast;symbol ["" p])) params)] - (` (def: (~ (ast;symbol ["" def-name])) + (let [params' (map (function [[p _]] (code;symbol ["" p])) params)] + (` (def: (~ (code;symbol ["" def-name])) {#;type? true - #;;jvm-class (~ (ast;text full-name))} + #;;jvm-class (~ (code;text full-name))} Type (All [(~@ params')] - (host (~ (ast;symbol ["" full-name])) + (host (~ (code;symbol ["" full-name])) [(~@ params')])))))))) (def: (member-type-vars class-tvars member) @@ -1570,13 +1570,13 @@ class-tvars)) (def: (member-def-arg-bindings type-params class member) - (-> (List TypeParam) ClassDecl ImportMemberDecl (Lux [(List AST) (List AST) (List Text) (List AST)])) + (-> (List TypeParam) ClassDecl ImportMemberDecl (Lux [(List Code) (List Code) (List Text) (List Code)])) (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (let [(^slots [#import-member-tvars #import-member-args]) commons] (do Monad<Lux> [arg-inputs (mapM @ - (: (-> [Bool GenericType] (Lux [AST AST])) + (: (-> [Bool GenericType] (Lux [Code Code])) (function [[maybe? _]] (with-gensyms [arg-name] (wrap [arg-name (if maybe? @@ -1586,7 +1586,7 @@ #let [arg-classes (: (List Text) (map (. (simple-class$ (List/append type-params import-member-tvars)) product;right) import-member-args)) - arg-types (map (: (-> [Bool GenericType] AST) + arg-types (map (: (-> [Bool GenericType] Code) (function [[maybe? arg]] (let [arg-type (class->type (get@ #import-member-mode commons) type-params arg)] (if maybe? @@ -1601,7 +1601,7 @@ (:: Monad<Lux> wrap [(list) (list) (list) (list)]))) (def: (member-def-return mode type-params class member) - (-> Primitive-Mode (List TypeParam) ClassDecl ImportMemberDecl (Lux AST)) + (-> Primitive-Mode (List TypeParam) ClassDecl ImportMemberDecl (Lux Code)) (case member (#ConstructorDecl _) (:: Monad<Lux> wrap (class-decl-type$ class)) @@ -1613,14 +1613,14 @@ (macro;fail "Only methods have return values."))) (def: (decorate-return-maybe member [return-type return-term]) - (-> ImportMemberDecl [AST AST] [AST AST]) + (-> ImportMemberDecl [Code Code] [Code Code]) (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (if (get@ #import-member-maybe? commons) [(` (Maybe (~ return-type))) (` (??? (~ return-term)))] [return-type - (let [g!temp (ast;symbol ["" "Ω"])] + (let [g!temp (code;symbol ["" "Ω"])] (` (let [(~ g!temp) (~ return-term)] (if (not (null? (:! (host (~' java.lang.Object)) (~ g!temp)))) @@ -1632,7 +1632,7 @@ (do-template [<name> <tag> <type-trans> <term-trans>] [(def: (<name> member [return-type return-term]) - (-> ImportMemberDecl [AST AST] [AST AST]) + (-> ImportMemberDecl [Code Code] [Code Code]) (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (if (get@ <tag> commons) @@ -1653,11 +1653,11 @@ _ false)) (def: (type-param->type-arg [name _]) - (-> TypeParam AST) - (ast;symbol ["" name])) + (-> TypeParam Code) + (code;symbol ["" name])) (def: (with-mode-output mode output-type body) - (-> Primitive-Mode GenericType AST AST) + (-> Primitive-Mode GenericType Code Code) (case mode #ManualPrM body @@ -1689,7 +1689,7 @@ false)) (def: (auto-conv [class var]) - (-> [Text AST] (List AST)) + (-> [Text Code] (List Code)) (case class "byte" (list var (` (l2b (~ var)))) "short" (list var (` (l2s (~ var)))) @@ -1698,7 +1698,7 @@ _ (list))) (def: (with-mode-inputs mode inputs body) - (-> Primitive-Mode (List [Text AST]) AST AST) + (-> Primitive-Mode (List [Text Code]) Code Code) (case mode #ManualPrM body @@ -1710,7 +1710,7 @@ (~ body))))) (def: (with-mode-field-get mode class output) - (-> Primitive-Mode GenericType AST AST) + (-> Primitive-Mode GenericType Code Code) (case mode #ManualPrM output @@ -1724,7 +1724,7 @@ _ output))) (def: (with-mode-field-set mode class input) - (-> Primitive-Mode GenericType AST AST) + (-> Primitive-Mode GenericType Code Code) (case mode #ManualPrM input @@ -1738,7 +1738,7 @@ _ input))) (def: (member-def-interop type-params kind class [arg-function-inputs arg-method-inputs arg-classes arg-types] member method-prefix) - (-> (List TypeParam) ClassKind ClassDecl [(List AST) (List AST) (List Text) (List AST)] ImportMemberDecl Text (Lux (List AST))) + (-> (List TypeParam) ClassKind ClassDecl [(List Code) (List Code) (List Text) (List Code)] ImportMemberDecl Text (Lux (List Code))) (let [[full-name class-tvars] class all-params (|> (member-type-vars class-tvars member) (filter free-type-param?) @@ -1746,30 +1746,30 @@ (case member (#EnumDecl enum-members) (do Monad<Lux> - [#let [enum-type (: AST + [#let [enum-type (: Code (case class-tvars #;Nil - (` (host (~ (ast;symbol ["" full-name])))) + (` (host (~ (code;symbol ["" full-name])))) _ (let [=class-tvars (|> class-tvars (filter free-type-param?) (map type-param->type-arg))] - (` (All [(~@ =class-tvars)] (host (~ (ast;symbol ["" full-name])) [(~@ =class-tvars)])))))) - getter-interop (: (-> Text AST) + (` (All [(~@ =class-tvars)] (host (~ (code;symbol ["" full-name])) [(~@ =class-tvars)])))))) + getter-interop (: (-> Text Code) (function [name] - (let [getter-name (ast;symbol ["" (format method-prefix member-separator name)])] + (let [getter-name (code;symbol ["" (format method-prefix member-separator name)])] (` (def: (~ getter-name) (~ enum-type) - (;_lux_proc ["jvm" (~ (ast;text (format "getstatic" ":" full-name ":" name)))] []))))))]] + (;_lux_proc ["jvm" (~ (code;text (format "getstatic" ":" full-name ":" name)))] []))))))]] (wrap (map getter-interop enum-members))) (#ConstructorDecl [commons _]) (do Monad<Lux> [return-type (member-def-return (get@ #import-member-mode commons) type-params class member) - #let [def-name (ast;symbol ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) - def-params (list (ast;tuple arg-function-inputs)) - jvm-interop (|> (` (;_lux_proc ["jvm" (~ (ast;text (format "new" ":" full-name ":" (text;join-with "," arg-classes))))] + #let [def-name (code;symbol ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) + def-params (list (code;tuple arg-function-inputs)) + jvm-interop (|> (` (;_lux_proc ["jvm" (~ (code;text (format "new" ":" full-name ":" (text;join-with "," arg-classes))))] [(~@ arg-method-inputs)])) (with-mode-inputs (get@ #import-member-mode commons) (list;zip2 arg-classes arg-function-inputs))) @@ -1785,10 +1785,10 @@ (with-gensyms [g!obj] (do @ [return-type (member-def-return (get@ #import-member-mode commons) type-params class member) - #let [def-name (ast;symbol ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) + #let [def-name (code;symbol ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) (^slots [#import-member-kind]) commons (^slots [#import-method-name]) method - [jvm-op obj-ast class-ast] (: [Text (List AST) (List AST)] + [jvm-op obj-ast class-ast] (: [Text (List Code) (List Code)] (case import-member-kind #StaticIMK ["invokestatic" @@ -1807,10 +1807,10 @@ (list g!obj) (list (class-decl-type$ class))] ))) - def-params (#;Cons (ast;tuple arg-function-inputs) obj-ast) + def-params (#;Cons (code;tuple arg-function-inputs) obj-ast) def-param-types (#;Cons (` [(~@ arg-types)]) class-ast) - jvm-interop (|> (` (;_lux_proc ["jvm" (~ (ast;text (format jvm-op ":" full-name ":" import-method-name - ":" (text;join-with "," arg-classes))))] + jvm-interop (|> (` (;_lux_proc ["jvm" (~ (code;text (format jvm-op ":" full-name ":" import-method-name + ":" (text;join-with "," arg-classes))))] [(~@ obj-ast) (~@ arg-method-inputs)])) (with-mode-output (get@ #import-member-mode commons) (get@ #import-method-return method)) @@ -1832,12 +1832,12 @@ g!type (if import-field-maybe? (` (Maybe (~ base-gtype))) base-gtype) - tvar-asts (: (List AST) + tvar-asts (: (List Code) (|> class-tvars (filter free-type-param?) (map type-param->type-arg))) - getter-name (ast;symbol ["" (format method-prefix member-separator import-field-name)]) - setter-name (ast;symbol ["" (format method-prefix member-separator import-field-name "!")])] + getter-name (code;symbol ["" (format method-prefix member-separator import-field-name)]) + setter-name (code;symbol ["" (format method-prefix member-separator import-field-name "!")])] getter-interop (with-gensyms [g!obj] (let [getter-call (if import-field-static? getter-name @@ -1851,9 +1851,9 @@ getter-type (` (All [(~@ tvar-asts)] (~ getter-type))) getter-body (if import-field-static? (with-mode-field-get import-field-mode import-field-type - (` (;_lux_proc ["jvm" (~ (ast;text (format "getstatic" ":" full-name ":" import-field-name)))] []))) + (` (;_lux_proc ["jvm" (~ (code;text (format "getstatic" ":" full-name ":" import-field-name)))] []))) (with-mode-field-get import-field-mode import-field-type - (` (;_lux_proc ["jvm" (~ (ast;text (format "getfield" ":" full-name ":" import-field-name)))] [(~ g!obj)])))) + (` (;_lux_proc ["jvm" (~ (code;text (format "getfield" ":" full-name ":" import-field-name)))] [(~ g!obj)])))) getter-body (if import-field-maybe? (` (??? (~ getter-body))) getter-body) @@ -1877,17 +1877,17 @@ setter-value) setter-command (format (if import-field-static? "putstatic" "putfield") ":" full-name ":" import-field-name)] - (wrap (: (List AST) + (wrap (: (List Code) (list (` (def: (~ setter-call) (~ setter-type) - (io (;_lux_proc ["jvm" (~ (ast;text setter-command))] + (io (;_lux_proc ["jvm" (~ (code;text setter-command))] [(~ setter-value)]))))))))) (wrap (list)))] (wrap (list& getter-interop setter-interop))) ))) (def: (member-import$ type-params long-name? kind class member) - (-> (List TypeParam) Bool ClassKind ClassDecl ImportMemberDecl (Lux (List AST))) + (-> (List TypeParam) Bool ClassKind ClassDecl ImportMemberDecl (Lux (List Code))) (let [[full-name _] class method-prefix (if long-name? full-name @@ -1992,7 +1992,7 @@ ["char" "cnewarray"]) _ - (wrap (list (` (;_lux_proc ["jvm" "anewarray"] [(~ (ast;text (generic-type$ type))) (~ size)])))))) + (wrap (list (` (;_lux_proc ["jvm" "anewarray"] [(~ (code;text (generic-type$ type))) (~ size)])))))) (syntax: #export (array-length array) {#;doc (doc "Gives the length of an array." @@ -2082,7 +2082,7 @@ (;;array-store (~ g!array) (~ idx) (~ value))))))))) (def: simple-bindings^ - (Syntax (List [Text AST])) + (Syntax (List [Text Code])) (s;tuple (s;some (s;seq s;local-symbol s;any)))) (syntax: #export (with-open [bindings simple-bindings^] body) @@ -2096,11 +2096,11 @@ (do-one-last-thing foo bar))))} (with-gensyms [g!output g!_] (let [inits (List/join (List/map (function [[res-name res-ctor]] - (list (ast;symbol ["" res-name]) res-ctor)) + (list (code;symbol ["" res-name]) res-ctor)) bindings)) closes (List/map (function [res] (` (try (;_lux_proc ["jvm" "invokevirtual:java.io.Closeable:close:"] - [(~ (ast;symbol ["" (product;left res)]))])))) + [(~ (code;symbol ["" (product;left res)]))])))) bindings)] (wrap (list (` (do Monad<IO> [(~@ inits) @@ -2112,7 +2112,7 @@ [type (generic-type^ imports (list))]) {#;doc (doc "Loads the class as a java.lang.Class object." (class-for java.lang.String))} - (wrap (list (` (;_lux_proc ["jvm" "load-class"] [(~ (ast;text (simple-class$ (list) type)))]))))) + (wrap (list (` (;_lux_proc ["jvm" "load-class"] [(~ (code;text (simple-class$ (list) type)))]))))) (def: get-compiler (Lux Compiler) diff --git a/stdlib/source/lux/io.lux b/stdlib/source/lux/io.lux index 00f16afce..d15c75729 100644 --- a/stdlib/source/lux/io.lux +++ b/stdlib/source/lux/io.lux @@ -19,7 +19,7 @@ "Some value...")))} (case tokens (^ (list value)) - (let [blank (: AST [["" +0 +0] (#;Symbol ["" ""])])] + (let [blank (: Code [["" +0 +0] (#;Symbol ["" ""])])] (#;Right [state (list (` (;_lux_function (~ blank) (~ blank) (~ value))))])) _ diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 5ac4a524e..5ff8b5073 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -1,6 +1,6 @@ (;module: {#;doc "Functions for extracting information from the state of the compiler."} lux - (lux (macro [ast]) + (lux (macro [code]) (control functor applicative monad) @@ -276,7 +276,7 @@ {#;doc "Given code that requires applying a macro, does it once and returns the result. Otherwise, returns the code as-is."} - (-> AST (Lux (List AST))) + (-> Code (Lux (List Code))) (case syntax [_ (#;Form (#;Cons [[_ (#;Symbol macro-name)] args]))] (do Monad<Lux> @@ -296,7 +296,7 @@ {#;doc "Given code that requires applying a macro, expands repeatedly until no more direct macro-calls are left. Otherwise, returns the code as-is."} - (-> AST (Lux (List AST))) + (-> Code (Lux (List Code))) (case syntax [_ (#;Form (#;Cons [[_ (#;Symbol macro-name)] args]))] (do Monad<Lux> @@ -317,7 +317,7 @@ (def: #export (macro-expand-all syntax) {#;doc "Expands all macro-calls everywhere recursively, until only primitive/base code remains."} - (-> AST (Lux (List AST))) + (-> Code (Lux (List Code))) (case syntax [_ (#;Form (#;Cons [[_ (#;Symbol macro-name)] args]))] (do Monad<Lux> @@ -332,40 +332,40 @@ #;None (do Monad<Lux> - [parts' (mapM Monad<Lux> macro-expand-all (list& (ast;symbol macro-name) args))] - (wrap (list (ast;form (:: Monad<List> join parts'))))))) + [parts' (mapM Monad<Lux> macro-expand-all (list& (code;symbol macro-name) args))] + (wrap (list (code;form (:: Monad<List> join parts'))))))) [_ (#;Form (#;Cons [harg targs]))] (do Monad<Lux> [harg+ (macro-expand-all harg) targs+ (mapM Monad<Lux> macro-expand-all targs)] - (wrap (list (ast;form (List/append harg+ (:: Monad<List> join (: (List (List AST)) targs+))))))) + (wrap (list (code;form (List/append harg+ (:: Monad<List> join (: (List (List Code)) targs+))))))) [_ (#;Tuple members)] (do Monad<Lux> [members' (mapM Monad<Lux> macro-expand-all members)] - (wrap (list (ast;tuple (:: Monad<List> join members'))))) + (wrap (list (code;tuple (:: Monad<List> join members'))))) _ (:: Monad<Lux> wrap (list syntax)))) (def: #export (gensym prefix) - {#;doc "Generates a unique identifier as an AST node (ready to be used in code templates). + {#;doc "Generates a unique identifier as an Code node (ready to be used in code templates). A prefix can be given (or just be empty text \"\") to better identify the code for debugging purposes."} - (-> Text (Lux AST)) + (-> Text (Lux Code)) (function [state] (#;Right [(update@ #;seed n.inc state) - (ast;symbol ["" ($_ Text/append "__gensym__" prefix (:: number;Codec<Text,Nat> encode (get@ #;seed state)))])]))) + (code;symbol ["" ($_ Text/append "__gensym__" prefix (:: number;Codec<Text,Nat> encode (get@ #;seed state)))])]))) (def: (get-local-symbol ast) - (-> AST (Lux Text)) + (-> Code (Lux Text)) (case ast [_ (#;Symbol [_ name])] (:: Monad<Lux> wrap name) _ - (fail (Text/append "AST is not a local symbol: " (ast;to-text ast))))) + (fail (Text/append "Code is not a local symbol: " (code;to-text ast))))) (macro: #export (with-gensyms tokens) {#;doc (doc "Creates new symbols and offers them to the body expression." @@ -381,8 +381,8 @@ (^ (list [_ (#;Tuple symbols)] body)) (do Monad<Lux> [symbol-names (mapM @ get-local-symbol symbols) - #let [symbol-defs (List/join (List/map (: (-> Text (List AST)) - (function [name] (list (ast;symbol ["" name]) (` (gensym (~ (ast;text name))))))) + #let [symbol-defs (List/join (List/map (: (-> Text (List Code)) + (function [name] (list (code;symbol ["" name]) (` (gensym (~ (code;text name))))))) symbol-names))]] (wrap (list (` (do Monad<Lux> [(~@ symbol-defs)] @@ -392,8 +392,8 @@ (fail "Wrong syntax for with-gensyms"))) (def: #export (macro-expand-1 token) - {#;doc "Works just like macro-expand, except that it ensures that the output is a single AST token."} - (-> AST (Lux AST)) + {#;doc "Works just like macro-expand, except that it ensures that the output is a single Code token."} + (-> Code (Lux Code)) (do Monad<Lux> [token+ (macro-expand token)] (case token+ @@ -620,8 +620,8 @@ (do-template [<macro> <func> <desc>] [(macro: #export (<macro> tokens) - {#;doc (doc "Performs a macro-expansion and logs the resulting ASTs." - "You can either use the resulting ASTs, or omit them." + {#;doc (doc "Performs a macro-expansion and logs the resulting code." + "You can either use the resulting code, or omit them." "By omitting them, this macro produces nothing (just like the lux;comment macro)." (<macro> #omit (def: (foo bar baz) @@ -632,14 +632,14 @@ token)) (do Monad<Lux> [output (<func> token) - #let [_ (List/map (. log! ast;to-text) + #let [_ (List/map (. log! code;to-text) output)]] (wrap (list))) (^ (list token)) (do Monad<Lux> [output (<func> token) - #let [_ (List/map (. log! ast;to-text) + #let [_ (List/map (. log! code;to-text) output)]] (wrap output)) diff --git a/stdlib/source/lux/macro/ast.lux b/stdlib/source/lux/macro/code.lux index ac65155e4..6d2dd4604 100644 --- a/stdlib/source/lux/macro/ast.lux +++ b/stdlib/source/lux/macro/code.lux @@ -10,7 +10,7 @@ ))) ## [Types] -## (type: (AST' w) +## (type: (Code' w) ## (#;Bool Bool) ## (#;Nat Nat) ## (#;Int Int) @@ -19,12 +19,12 @@ ## (#;Text Text) ## (#;Symbol Text Text) ## (#;Tag Text Text) -## (#;Form (List (w (AST' w)))) -## (#;Tuple (List (w (AST' w)))) -## (#;Record (List [(w (AST' w)) (w (AST' w))]))) +## (#;Form (List (w (Code' w)))) +## (#;Tuple (List (w (Code' w)))) +## (#;Record (List [(w (Code' w)) (w (Code' w))]))) -## (type: AST -## (Meta Cursor (AST' (Meta Cursor)))) +## (type: Code +## (Meta Cursor (Code' (Meta Cursor)))) ## [Utils] (def: _cursor Cursor ["" +0 +0]) @@ -32,34 +32,34 @@ ## [Functions] (do-template [<name> <type> <tag>] [(def: #export (<name> x) - (-> <type> AST) + (-> <type> Code) [_cursor (<tag> x)])] - [bool Bool #;Bool] - [nat Nat #;Nat] - [int Int #;Int] - [deg Deg #;Deg] - [real Real #;Real] - [char Char #;Char] - [text Text #;Text] - [symbol Ident #;Symbol] - [tag Ident #;Tag] - [form (List AST) #;Form] - [tuple (List AST) #;Tuple] - [record (List [AST AST]) #;Record] + [bool Bool #;Bool] + [nat Nat #;Nat] + [int Int #;Int] + [deg Deg #;Deg] + [real Real #;Real] + [char Char #;Char] + [text Text #;Text] + [symbol Ident #;Symbol] + [tag Ident #;Tag] + [form (List Code) #;Form] + [tuple (List Code) #;Tuple] + [record (List [Code Code]) #;Record] ) (do-template [<name> <tag> <doc>] [(def: #export (<name> name) {#;doc <doc>} - (-> Text AST) + (-> Text Code) [_cursor (<tag> ["" name])])] [local-symbol #;Symbol "Produces a local symbol (a symbol with no module prefix)."] [local-tag #;Tag "Produces a local tag (a tag with no module prefix)."]) ## [Structures] -(struct: #export _ (Eq AST) +(struct: #export _ (Eq Code) (def: (= x y) (case [x y] (^template [<tag> <eq>] @@ -97,7 +97,7 @@ ## [Values] (def: #export (to-text ast) - (-> AST Text) + (-> Code Text) (case ast (^template [<tag> <struct>] [_ (<tag> value)] @@ -125,9 +125,9 @@ )) (def: #export (replace original substitute ast) - {#;doc "Replaces all ASTs that look like 'original' with the 'substitute' in the given AST."} - (-> AST AST AST AST) - (if (:: Eq<AST> = original ast) + {#;doc "Replaces all code that looks like the 'original' with the 'substitute'."} + (-> Code Code Code Code) + (if (:: Eq<Code> = original ast) substitute (case ast (^template [<tag>] diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index decc25b93..24e9c0be9 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -12,7 +12,7 @@ [char] [maybe]) [macro #+ Monad<Lux> with-gensyms] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax] (syntax [common])) [type] @@ -22,7 +22,7 @@ (type: #export (Matcher a) (-> Type (Lux a))) -(type: #export Env (Dict Nat [Type AST])) +(type: #export Env (Dict Nat [Type Code])) ## [Combinators] (do-template [<combinator> <name> <type>] @@ -81,8 +81,8 @@ ($_ macro;either <primitives>)))) -(syntax: ($AST$ ast) - (wrap (;list (ast;text (ast;to-text ast))))) +(syntax: ($Code$ ast) + (wrap (;list (code;text (code;to-text ast))))) (do-template [<single> <multi> <flattener> <tag>] [(def: #export <single> @@ -93,7 +93,7 @@ (:: macro;Monad<Lux> wrap [:left: :right:]) _ - (macro;fail (format "Not a " ($AST$ <tag>) " type: " (%type :type:)))))) + (macro;fail (format "Not a " ($Code$ <tag>) " type: " (%type :type:)))))) (def: #export <multi> (Matcher (List Type)) @@ -101,7 +101,7 @@ (let [members (<flattener> (type;un-name :type:))] (if (n.> +1 (list;size members)) (:: macro;Monad<Lux> wrap members) - (macro;fail (format "Not a " ($AST$ <tag>) " type: " (%type :type:)))))))] + (macro;fail (format "Not a " ($Code$ <tag>) " type: " (%type :type:)))))))] [sum sum+ type;flatten-variant #;Sum] [prod prod+ type;flatten-tuple #;Product] @@ -138,7 +138,7 @@ (macro;fail (format "Unnamed types cannot have tags: " (%type :type:)))))) (def: #export polymorphic - (Matcher [(List AST) Type]) + (Matcher [(List Code) Type]) (;function [:type:] (loop [:type: (type;un-name :type:)] (case :type: @@ -154,7 +154,7 @@ (do-template [<combinator> <sub-comb> <build>] [(def: #export <combinator> - (Matcher [(List AST) (List [Ident Type])]) + (Matcher [(List Code) (List [Ident Type])]) (;function [:type:] (do macro;Monad<Lux> [[tags :type:] (tagged :type:) @@ -175,7 +175,7 @@ ) (def: #export tuple - (Matcher [(List AST) (List Type)]) + (Matcher [(List Code) (List Type)]) (;function [:type:] (do macro;Monad<Lux> [[vars :type:] (polymorphic :type:) @@ -183,7 +183,7 @@ (wrap [vars members])))) (def: #export function - (Matcher [(List AST) [(List Type) Type]]) + (Matcher [(List Code) [(List Type) Type]]) (;function [:type:] (do macro;Monad<Lux> [[vars :type:] (polymorphic :type:) @@ -233,7 +233,7 @@ (|> env-level n.dec (n.- bound-level) (n.* +2) (n.+ bound-idx)))) (def: #export (bound env) - (-> Env (Matcher AST)) + (-> Env (Matcher Code)) (;function [:type:] (case :type: (#;Bound idx) @@ -248,7 +248,7 @@ (macro;fail (format "Not a bound type: " (%type :type:)))))) (def: #export (recur env) - (-> Env (Matcher AST)) + (-> Env (Matcher Code)) (;function [:type:] (do Monad<Lux> [[t-func t-args] (apply :type:)] @@ -286,7 +286,7 @@ ## [Syntax] (def: #export (extend-env [funcT funcA] type-vars env) - (-> [Type AST] (List [Type AST]) Env Env) + (-> [Type Code] (List [Type Code]) Env Env) (case type-vars #;Nil env @@ -307,16 +307,16 @@ (s;many s;local-symbol)))] body) (with-gensyms [g!body] - (let [g!inputs (List/map (|>. [""] ast;symbol) inputs) - g!name (ast;symbol ["" name]) - g!env (ast;symbol ["" env])] + (let [g!inputs (List/map (|>. [""] code;symbol) inputs) + g!name (code;symbol ["" name]) + g!env (code;symbol ["" env])] (wrap (;list (` (syntax: (~@ (common;gen-export-level _ex-lev)) ((~ g!name) (~@ (List/map (;function [g!input] (` [(~ g!input) s;symbol])) g!inputs))) (do Monad<Lux> [(~@ (List/join (List/map (;function [g!input] (;list g!input (` (macro;find-type-def (~ g!input))))) g!inputs))) (~' #let) [(~ g!env) (: Env (dict;new number;Hash<Nat>))] - (~ g!body) (: (Lux AST) + (~ g!body) (: (Lux Code) (loop [(~ g!env) (~ g!env) (~@ (List/join (List/map (;function [g!input] (;list g!input g!input)) g!inputs)))] @@ -356,18 +356,18 @@ custom-impl #;None - (` ((~ (ast;symbol poly-func)) (~@ (List/map ast;symbol poly-args)))))]] + (` ((~ (code;symbol poly-func)) (~@ (List/map code;symbol poly-args)))))]] (wrap (;list (` (def: (~@ (common;gen-export-level _ex-lev)) - (~ (ast;symbol ["" name])) + (~ (code;symbol ["" name])) {#;struct? true} (~ impl))))))) ## [Derivers] (def: (to-ast env type) - (-> Env Type AST) + (-> Env Type Code) (case type (#;Host name params) - (` (#;Host (~ (ast;text name)) + (` (#;Host (~ (code;text name)) (list (~@ (List/map (to-ast env) params))))) (^template [<tag>] @@ -377,14 +377,14 @@ (^template [<tag>] (<tag> idx) - (` (<tag> (~ (ast;nat idx))))) + (` (<tag> (~ (code;nat idx))))) ([#;Var] [#;Ex]) (#;Bound idx) (let [idx (adjusted-idx env idx)] (if (n.= +0 idx) (|> (dict;get idx env) (default (undefined)) product;left (to-ast env)) - (` (;$ (~ (ast;nat (n.dec idx))))))) + (` (;$ (~ (code;nat (n.dec idx))))))) (^template [<tag>] (<tag> left right) @@ -399,7 +399,7 @@ [#;Product & type;flatten-tuple]) (#;Named name sub-type) - (ast;symbol name) + (code;symbol name) (^template [<tag>] (<tag> scope body) @@ -409,7 +409,7 @@ )) (def: #export (gen-type env converter type-fun tvars type) - (-> Env (-> AST AST) AST (List AST) Type AST) + (-> Env (-> Code Code) Code (List Code) Type Code) (let [type' (to-ast env type)] (case tvars #;Nil diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux index dc3b84cce..f1a184c85 100644 --- a/stdlib/source/lux/macro/poly/eq.lux +++ b/stdlib/source/lux/macro/poly/eq.lux @@ -12,7 +12,7 @@ [char] [maybe]) [macro #+ Monad<Lux> with-gensyms] - (macro [ast] + (macro [code] [syntax #+ syntax: Syntax] (syntax [common]) [poly #+ poly:]) @@ -21,7 +21,7 @@ ## [Utils] (def: (function$ func inputs output) - (-> AST (List AST) AST AST) + (-> Code (List Code) Code Code) (case inputs #;Nil output @@ -33,7 +33,7 @@ ## [Derivers] (poly: #export (Eq<?> env :x:) - (let [->Eq (: (-> AST AST) + (let [->Eq (: (-> Code Code) (function [.type.] (` (eq;Eq (~ .type.)))))] (with-expansions [<basic> (do-template [<type> <matcher> <eq>] @@ -64,8 +64,8 @@ (function [[name :case:]] (do @ [g!eq (Eq<?> new-env :case:)] - (wrap (list (` [((~ (ast;tag name)) (~ g!left)) - ((~ (ast;tag name)) (~ g!right))]) + (wrap (list (` [((~ (code;tag name)) (~ g!left)) + ((~ (code;tag name)) (~ g!right))]) (` ((~ g!eq) (~ g!left) (~ g!right))))))) members) #let [base (function$ g!type-fun g!vars diff --git a/stdlib/source/lux/macro/poly/functor.lux b/stdlib/source/lux/macro/poly/functor.lux index 6e262f47e..06ebe60e4 100644 --- a/stdlib/source/lux/macro/poly/functor.lux +++ b/stdlib/source/lux/macro/poly/functor.lux @@ -14,7 +14,7 @@ [ident "Ident/" Codec<Text,Ident>] error) [macro #+ Monad<Lux> with-gensyms] - (macro [ast] + (macro [code] [syntax #+ syntax: Syntax] (syntax [common]) [poly #+ poly:]) @@ -33,13 +33,13 @@ env)] _ (macro;assert "Functors must have at least 1 type-variable." (n.> +0 num-vars))] - (let [->Functor (: (-> AST AST) + (let [->Functor (: (-> Code Code) (function [.type.] (if (n.= +1 num-vars) (` (functor;Functor (~ .type.))) - (let [type-params (|> num-vars n.dec list;indices (List/map (|>. %n ast;local-symbol)))] + (let [type-params (|> num-vars n.dec list;indices (List/map (|>. %n code;local-symbol)))] (` (All [(~@ type-params)] (functor;Functor ((~ .type.) (~@ type-params))))))))) - Arg<?> (: (-> AST (poly;Matcher AST)) + Arg<?> (: (-> Code (poly;Matcher Code)) (function Arg<?> [value :type:] ($_ macro;either ## Nothing to do. @@ -80,10 +80,10 @@ pattern-matching (mapM @ (function [[name :case:]] (do @ - [#let [analysis (` ((~ (ast;tag name)) (~ g!input)))] + [#let [analysis (` ((~ (code;tag name)) (~ g!input)))] synthesis (Arg<?> g!input :case:)] (wrap (list analysis - (` ((~ (ast;tag name)) (~ synthesis))))))) + (` ((~ (code;tag name)) (~ synthesis))))))) cases)] (wrap (` (: (~ (->Functor (type;to-ast :x:))) (struct (def: ((~ g!map) (~ g!func) (~ g!input)) diff --git a/stdlib/source/lux/macro/poly/text-encoder.lux b/stdlib/source/lux/macro/poly/text-encoder.lux index 10fd85ebe..2dde16640 100644 --- a/stdlib/source/lux/macro/poly/text-encoder.lux +++ b/stdlib/source/lux/macro/poly/text-encoder.lux @@ -14,7 +14,7 @@ [ident "Ident/" Codec<Text,Ident>] error) [macro #+ Monad<Lux> with-gensyms] - (macro [ast] + (macro [code] [syntax #+ syntax: Syntax] (syntax [common]) [poly #+ poly:]) @@ -22,7 +22,7 @@ )) (def: (function$ func inputs output) - (-> AST (List AST) AST AST) + (-> Code (List Code) Code Code) (case inputs #;Nil output @@ -34,7 +34,7 @@ ## [Derivers] (poly: #export (Codec<Text,?>::encode env :x:) - (let [->Codec::encode (: (-> AST AST) + (let [->Codec::encode (: (-> Code Code) (function [.type.] (` (-> (~ .type.) Text))))] (with-expansions [<basic> (do-template [<type> <matcher> <encoder>] @@ -65,9 +65,9 @@ (function [[name :case:]] (do @ [encoder (Codec<Text,?>::encode new-env :case:)] - (wrap (list (` ((~ (ast;tag name)) (~ g!case))) + (wrap (list (` ((~ (code;tag name)) (~ g!case))) (` (format "(#" - (~ (ast;text (Ident/encode name))) + (~ (code;text (Ident/encode name))) " " ((~ encoder) (~ g!case)) ")")))))) @@ -91,9 +91,9 @@ (do @ [encoder (Codec<Text,?>::encode new-env :slot:)] (wrap (` (format "#" - (~ (ast;text (Ident/encode name))) + (~ (code;text (Ident/encode name))) " " - ((~ encoder) (get@ (~ (ast;tag name)) (~ g!input)))))))) + ((~ encoder) (get@ (~ (code;tag name)) (~ g!input)))))))) slots) #let [base (function$ g!type-fun g!vars (` (function [(~ g!input)] diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index e2cbde491..c0fda8a62 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -13,7 +13,7 @@ (coll [list #* "" Functor<List> Fold<List> "List/" Monoid<List>]) [product] [error #- fail])) - (.. [ast "AST/" Eq<AST>])) + (.. [code "Code/" Eq<Code>])) ## [Utils] (def: (join-pairs pairs) @@ -24,8 +24,8 @@ ## [Types] (type: #export (Syntax a) - {#;doc "A Lux AST syntax parser."} - (-> (List AST) (Error [(List AST) a]))) + {#;doc "A Lux syntax parser."} + (-> (List Code) (Error [(List Code) a]))) ## [Structures] (struct: #export _ (Functor Syntax) @@ -72,14 +72,14 @@ ## [Utils] (def: (remaining-inputs asts) - (-> (List AST) Text) + (-> (List Code) Text) ($_ Text/append "\nRemaining input: " - (|> asts (map ast;to-text) (interpose " ") (text;join-with "")))) + (|> asts (map code;to-text) (interpose " ") (text;join-with "")))) ## [Syntaxs] (def: #export any {#;doc "Just returns the next input without applying any logic."} - (Syntax AST) + (Syntax Code) (function [tokens] (case tokens #;Nil (#;Left "There are no tokens to parse!") @@ -87,7 +87,7 @@ (do-template [<get-name> <type> <tag> <eq> <desc>] [(def: #export <get-name> - {#;doc (#;TextA ($_ Text/append "Parses the next " <desc> " input AST."))} + {#;doc (#;TextA ($_ Text/append "Parses the next " <desc> " input Code."))} (Syntax <type>) (function [tokens] (case tokens @@ -109,12 +109,12 @@ ) (def: #export (this? ast) - {#;doc "Asks if the given AST is the next input."} - (-> AST (Syntax Bool)) + {#;doc "Asks if the given Code is the next input."} + (-> Code (Syntax Bool)) (function [tokens] (case tokens (#;Cons [token tokens']) - (let [is-it? (AST/= ast token) + (let [is-it? (Code/= ast token) remaining (if is-it? tokens' tokens)] @@ -124,14 +124,14 @@ (#;Right [tokens false])))) (def: #export (this! ast) - {#;doc "Ensures the given AST is the next input."} - (-> AST (Syntax Unit)) + {#;doc "Ensures the given Code is the next input."} + (-> Code (Syntax Unit)) (function [tokens] (case tokens (#;Cons [token tokens']) - (if (AST/= ast token) + (if (Code/= ast token) (#;Right [tokens' []]) - (#;Left ($_ Text/append "Expected a " (ast;to-text ast) " but instead got " (ast;to-text token) + (#;Left ($_ Text/append "Expected a " (code;to-text ast) " but instead got " (code;to-text token) (remaining-inputs tokens)))) _ @@ -175,7 +175,7 @@ (do-template [<name> <tag> <desc>] [(def: #export (<name> p) - {#;doc (#;TextA ($_ Text/append "Parse inside the contents of a " <desc> " as if they were the input ASTs."))} + {#;doc (#;TextA ($_ Text/append "Parse inside the contents of a " <desc> " as if they were the input Codes."))} (All [a] (-> (Syntax a) (Syntax a))) (function [tokens] @@ -193,7 +193,7 @@ ) (def: #export (record p) - {#;doc (#;TextA ($_ Text/append "Parse inside the contents of a record as if they were the input ASTs."))} + {#;doc (#;TextA ($_ Text/append "Parse inside the contents of a record as if they were the input Codes."))} (All [a] (-> (Syntax a) (Syntax a))) (function [tokens] @@ -217,7 +217,7 @@ (def: #export (run tokens p) (All [a] - (-> (List AST) (Syntax a) (Error [(List AST) a]))) + (-> (List Code) (Syntax a) (Error [(List Code) a]))) (p tokens)) (def: #export (some p) @@ -388,7 +388,7 @@ (def: #export (local local-inputs syntax) {#;doc "Run a syntax parser with the given list of inputs, instead of the real ones."} - (All [a] (-> (List AST) (Syntax a) (Syntax a))) + (All [a] (-> (List Code) (Syntax a) (Syntax a))) (function [real-inputs] (case (syntax local-inputs) (#;Left error) @@ -401,7 +401,7 @@ _ (#;Left (Text/append "Unconsumed inputs: " - (|> (map ast;to-text unconsumed-inputs) + (|> (map code;to-text unconsumed-inputs) (text;join-with ", ")))))))) (def: #export (rec syntax) @@ -429,7 +429,7 @@ (with-brackets (spaced (map super-class-decl$ interfaces))) (with-brackets (spaced (map constructor-arg$ constructor-args))) (with-brackets (spaced (map (method-def$ id) methods))))))] - (wrap (list (` (;_lux_proc ["jvm" (~ (ast;text def-code))] [])))))))} + (wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] [])))))))} (let [[exported? tokens] (case tokens (^ (list& [_ (#;Tag ["" "hidden"])] tokens')) [(#;Some #;Left) tokens'] @@ -439,7 +439,7 @@ _ [#;None tokens]) - ?parts (: (Maybe [Text (List AST) AST AST]) + ?parts (: (Maybe [Text (List Code) Code Code]) (case tokens (^ (list [_ (#;Form (list& [_ (#;Symbol ["" name])] args))] body)) @@ -457,35 +457,35 @@ (with-gensyms [g!tokens g!body g!msg] (do Monad<Lux> [vars+parsers (mapM Monad<Lux> - (: (-> AST (Lux [AST AST])) + (: (-> Code (Lux [Code Code])) (function [arg] (case arg (^ [_ (#;Tuple (list var parser))]) (wrap [var parser]) [_ (#;Symbol var-name)] - (wrap [(ast;symbol var-name) (` any)]) + (wrap [(code;symbol var-name) (` any)]) _ (macro;fail "Syntax pattern expects tuples or symbols.")))) args) - #let [g!state (ast;symbol ["" "*compiler*"]) - g!end (ast;symbol ["" ""]) - error-msg (ast;text (Text/append "Wrong syntax for " name)) - export-ast (: (List AST) (case exported? - (#;Some #;Left) - (list (' #hidden)) - - (#;Some #;Right) - (list (' #export)) - - _ - (list)))]] - (wrap (list (` (macro: (~@ export-ast) ((~ (ast;symbol ["" name])) (~ g!tokens)) + #let [g!state (code;symbol ["" "*compiler*"]) + g!end (code;symbol ["" ""]) + error-msg (code;text (Text/append "Wrong syntax for " name)) + export-ast (: (List Code) (case exported? + (#;Some #;Left) + (list (' #hidden)) + + (#;Some #;Right) + (list (' #export)) + + _ + (list)))]] + (wrap (list (` (macro: (~@ export-ast) ((~ (code;symbol ["" name])) (~ g!tokens)) (~ meta) (function [(~ g!state)] (;_lux_case (run (~ g!tokens) - (: (Syntax (Lux (List AST))) + (: (Syntax (Lux (List Code))) (do Monad<Syntax> [(~@ (join-pairs vars+parsers)) (~ g!end) end!] diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux index a77a2428a..4f27108cd 100644 --- a/stdlib/source/lux/macro/syntax/common.lux +++ b/stdlib/source/lux/macro/syntax/common.lux @@ -8,7 +8,7 @@ [ident "Ident/" Eq<Ident>] [product]) [macro] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax]))) ## Exports @@ -26,7 +26,7 @@ (s;this! (' #hidden))))) (def: #export (gen-export-level ?el) - (-> (Maybe Export-Level) (List AST)) + (-> (Maybe Export-Level) (List Code)) (case ?el #;None (list) @@ -56,14 +56,14 @@ ## Definitions (type: #export Def-Syntax {#def-name Text - #def-type (Maybe AST) - #def-value AST - #def-anns (List [Ident AST]) + #def-type (Maybe Code) + #def-value Code + #def-anns (List [Ident Code]) #def-args (List Text) }) (def: check^ - (Syntax [(Maybe AST) AST]) + (Syntax [(Maybe Code) Code]) (s;either (s;form (do s;Monad<Syntax> [_ (s;this! (' lux;_lux_:)) type s;any @@ -77,7 +77,7 @@ (s;tuple (s;seq s;text s;text))) (def: (_def-anns^ _) - (-> Top (Syntax (List [Ident AST]))) + (-> Top (Syntax (List [Ident Code]))) (s;alt (s;this! (' #lux;Nil)) (s;form (do s;Monad<Syntax> [_ (s;this! (' #lux;Cons)) @@ -87,7 +87,7 @@ )) (def: (flat-list^ _) - (-> Top (Syntax (List AST))) + (-> Top (Syntax (List Code))) (s;either (do s;Monad<Syntax> [_ (s;this! (' #lux;Nil))] (wrap (list))) @@ -98,7 +98,7 @@ (wrap (#;Cons head tail)))))) (def: list-meta^ - (Syntax (List AST)) + (Syntax (List Code)) (s;form (do s;Monad<Syntax> [_ (s;this! (' #lux;ListA))] (flat-list^ [])))) @@ -110,7 +110,7 @@ s;text))) (def: (find-def-args meta-data) - (-> (List [Ident AST]) (List Text)) + (-> (List [Ident Code]) (List Text)) (default (list) (case (list;find (|>. product;left (Ident/= ["lux" "func-args"])) meta-data) (^=> (#;Some [_ value]) @@ -125,7 +125,7 @@ )) (def: #export (def compiler) - {#;doc "A parser that first macro-expands and then analyses the input AST, to ensure it's a definition."} + {#;doc "A parser that first macro-expands and then analyses the input Code, to ensure it's a definition."} (-> Compiler (Syntax Def-Syntax)) (do s;Monad<Syntax> [def-raw s;any @@ -162,12 +162,12 @@ (def: #export def-anns {#;doc "Parser for the common annotations syntax used by def: statements."} - (Syntax (List [Ident AST])) + (Syntax (List [Ident Code])) (s;record (s;some (s;seq s;tag s;any)))) (def: #export typed-arg {#;doc "Parser for the common typed-argument syntax used by many macros."} - (Syntax [Text AST]) + (Syntax [Text Code]) (s;tuple (s;seq s;local-symbol s;any))) (def: #export type-params diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index 4782b365b..1fb9d63db 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -7,7 +7,7 @@ text/format) [macro] (macro ["s" syntax #+ syntax: Syntax "s/" Functor<Syntax>] - [ast]))) + [code]))) ## [Values] (do-template [<name> <value>] @@ -98,23 +98,23 @@ ## [Syntax] (type: #rec Infix - (#Const AST) - (#Call (List AST)) - (#Infix Infix AST Infix)) + (#Const Code) + (#Call (List Code)) + (#Infix Infix Code Infix)) (def: (infix^ _) (-> Unit (Syntax Infix)) ($_ s;alt ($_ s;either - (s/map ast;bool s;bool) - (s/map ast;nat s;nat) - (s/map ast;int s;int) - (s/map ast;deg s;deg) - (s/map ast;real s;real) - (s/map ast;char s;char) - (s/map ast;text s;text) - (s/map ast;symbol s;symbol) - (s/map ast;tag s;tag)) + (s/map code;bool s;bool) + (s/map code;nat s;nat) + (s/map code;int s;int) + (s/map code;deg s;deg) + (s/map code;real s;real) + (s/map code;char s;char) + (s/map code;text s;text) + (s/map code;symbol s;symbol) + (s/map code;tag s;tag)) (s;form (s;many s;any)) (s;tuple (s;either (do s;Monad<Syntax> [_ (s;this! (' #and)) @@ -142,13 +142,13 @@ )) (def: (infix-to-prefix infix) - (-> Infix AST) + (-> Infix Code) (case infix (#Const value) value (#Call parts) - (ast;form parts) + (code;form parts) (#Infix left op right) (` ((~ op) (~ (infix-to-prefix right)) (~ (infix-to-prefix left)))) diff --git a/stdlib/source/lux/math/simple.lux b/stdlib/source/lux/math/simple.lux index 359a2d23b..26c212f82 100644 --- a/stdlib/source/lux/math/simple.lux +++ b/stdlib/source/lux/math/simple.lux @@ -5,7 +5,7 @@ [product] (coll [list])) [macro] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax]) [type] (type [check]))) @@ -71,7 +71,7 @@ (wrap (` <deg-op>)) (macro;fail (format "No operation for types: " (%type =x))))] - (wrap (list (` ($_ (~ op) (~ (ast;symbol x)) (~@ ys)))))) + (wrap (list (` ($_ (~ op) (~ (code;symbol x)) (~@ ys)))))) (+0 [(#;Right x) ys]) (do @ @@ -135,7 +135,7 @@ (wrap (` <deg-op>)) (macro;fail (format "No operation for types: " (%type =x))))] - (wrap (list (` ($_ (~ op) (~ (ast;symbol x)) (~@ ys)))))) + (wrap (list (` ($_ (~ op) (~ (code;symbol x)) (~@ ys)))))) (+0 [(#;Right x) ys]) (do @ @@ -189,7 +189,7 @@ (wrap (` <int-op>)) (macro;fail (format "No operation for types: " (%type =x))))] - (wrap (list (` ($_ (~ op) (~ (ast;symbol x)) (~@ ys)))))) + (wrap (list (` ($_ (~ op) (~ (code;symbol x)) (~@ ys)))))) (+0 [(#;Right x) ys]) (do @ @@ -234,7 +234,7 @@ (wrap (` <int-op>)) (macro;fail (format "No operation for type: " (%type =x))))] - (wrap (list (` ((~ op) (~ (ast;symbol x))))))) + (wrap (list (` ((~ op) (~ (code;symbol x))))))) (+1 x) (do @ @@ -279,7 +279,7 @@ (wrap (` <int-op>)) (macro;fail (format "No operation for type: " (%type =x))))] - (wrap (list (` ((~ op) (~ (ast;symbol x))))))) + (wrap (list (` ((~ op) (~ (code;symbol x))))))) (+1 x) (do @ diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 172d27376..e9e979ad2 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -2,7 +2,7 @@ lux (lux [macro #+ Monad<Lux> with-gensyms] (macro ["s" syntax #+ syntax: Syntax] - [ast]) + [code]) (control functor applicative monad) @@ -121,12 +121,12 @@ (type: Property-Test {#seed (Maybe Test-Config) - #bindings (List [AST AST]) - #body AST}) + #bindings (List [Code Code]) + #body Code}) (type: Test-Kind (#Property Property-Test) - (#Simple AST)) + (#Simple Code)) (def: config^ (Syntax Test-Config) @@ -227,13 +227,13 @@ [(` #;None) +100] (#;Some (#Seed value)) - [(` (#;Some (~ (ast;nat value)))) +100] + [(` (#;Some (~ (code;nat value)))) +100] (#;Some (#Times value)) [(` #;None) value]) bindings' (|> bindings (List/map pair-to-list) List/join)] (` (repeat (~ =seed) - (~ (ast;nat =times)) + (~ (code;nat =times)) (do R;Monad<Random> [(~@ bindings')] ((~' wrap) (;;try-body (io;io (~ body)))))))) @@ -277,7 +277,7 @@ (mapM @ exported-tests) (:: @ map List/join))) #let [tests+ (List/map (function [[module-name test desc]] - (` [(~ (ast;text module-name)) (~ (ast;symbol [module-name test])) (~ (ast;text desc))])) + (` [(~ (code;text module-name)) (~ (code;symbol [module-name test])) (~ (code;text desc))])) tests) num-tests (list;size tests+) groups (list;split-all promise;concurrency-level tests+)]] @@ -288,13 +288,13 @@ (list g!_ (` (run' (list (~@ group)))) (' #let) (` [(~ g!accum) (n.+ (~ g!_) (~ g!accum))]))) groups))) - (~' #let) [(~ g!_) (n.- (~ g!accum) (~ (ast;nat num-tests)))]] + (~' #let) [(~ g!_) (n.- (~ g!accum) (~ (code;nat num-tests)))]] (exec (log! ($_ _appendT_ "Test-suite finished." "\n" (_%i_ (nat-to-int (~ g!accum))) " out of " - (~ (|> num-tests nat-to-int _%i_ ast;text)) + (~ (|> num-tests nat-to-int _%i_ code;text)) " tests passed." "\n" (_%i_ (nat-to-int (~ g!_))) " tests failed.")) diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index 186cfac81..a58c87360 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -7,7 +7,7 @@ [number "Nat/" Codec<Text,Nat>] maybe (coll [list #+ "List/" Monad<List> Monoid<List> Fold<List>])) - (macro [ast]) + (macro [code]) )) ## [Utils] @@ -160,10 +160,10 @@ #;None)) (def: #export (to-ast type) - (-> Type AST) + (-> Type Code) (case type (#;Host name params) - (` (#;Host (~ (ast;text name)) + (` (#;Host (~ (code;text name)) (list (~@ (List/map to-ast params))))) (^template [<tag>] @@ -173,7 +173,7 @@ (^template [<tag>] (<tag> idx) - (` (<tag> (~ (ast;nat idx))))) + (` (<tag> (~ (code;nat idx))))) ([#;Var] [#;Ex] [#;Bound]) (^template [<tag>] @@ -189,7 +189,7 @@ [#;Product & flatten-tuple]) (#;Named name sub-type) - (ast;symbol name) + (code;symbol name) (^template [<tag>] (<tag> env body) diff --git a/stdlib/source/lux/type/auto.lux b/stdlib/source/lux/type/auto.lux index 6ba7cdb8b..cd6093f97 100644 --- a/stdlib/source/lux/type/auto.lux +++ b/stdlib/source/lux/type/auto.lux @@ -10,7 +10,7 @@ [bool] [product]) [macro #+ Monad<Lux>] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax]) [type] (type ["tc" check #+ Check Monad<Check>]) @@ -283,7 +283,7 @@ (do Monad<Lux> [alts import-structs] (test alts))))) (def: (var? input) - (-> AST Bool) + (-> Code Bool) (case input [_ (#;Symbol _)] true @@ -296,13 +296,13 @@ (list l r)) (def: (instance$ [constructor dependencies]) - (-> Instance AST) + (-> Instance Code) (case dependencies #;Nil - (ast;symbol constructor) + (code;symbol constructor) _ - (` ((~ (ast;symbol constructor)) (~@ (List/map instance$ dependencies)))))) + (` ((~ (code;symbol constructor)) (~@ (List/map instance$ dependencies)))))) (syntax: #export (::: [member s;symbol] [args (s;alt (s;seq (s;some s;symbol) s;end!) @@ -343,8 +343,8 @@ (#;Cons chosen #;Nil) (wrap (list (` (:: (~ (instance$ chosen)) - (~ (ast;local-symbol (product;right member))) - (~@ (List/map ast;symbol args)))))) + (~ (code;local-symbol (product;right member))) + (~@ (List/map code;symbol args)))))) _ (macro;fail (format "Too many options available: " @@ -358,6 +358,6 @@ [labels (seqM @ (list;repeat (list;size args) (macro;gensym ""))) #let [retry (` (let [(~@ (|> (list;zip2 labels args) (List/map join-pair) List/join))] - (;;::: (~ (ast;symbol member)) (~@ labels))))]] + (;;::: (~ (code;symbol member)) (~@ labels))))]] (wrap (list retry))) )) diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux index c481fa60e..7acddf750 100644 --- a/stdlib/test/test/lux/data/format/json.lux +++ b/stdlib/test/test/lux/data/format/json.lux @@ -17,7 +17,7 @@ [dict] [list])) [macro #+ with-gensyms] - (macro [ast] + (macro [code] [syntax #+ syntax:] [poly #+ derived:]) ["R" math/random] diff --git a/stdlib/test/test/lux/data/text/regex.lux b/stdlib/test/test/lux/data/text/regex.lux index 64be4766e..62953b20b 100644 --- a/stdlib/test/test/lux/data/text/regex.lux +++ b/stdlib/test/test/lux/data/text/regex.lux @@ -10,7 +10,7 @@ (text [lexer] ["&" regex])) [macro] - (macro [ast] + (macro [code] ["s" syntax #+ syntax:]) ["R" math/random]) lux/test) diff --git a/stdlib/test/test/lux/macro/ast.lux b/stdlib/test/test/lux/macro/code.lux index 8670ead71..2f05ad926 100644 --- a/stdlib/test/test/lux/macro/ast.lux +++ b/stdlib/test/test/lux/macro/code.lux @@ -6,15 +6,15 @@ text/format [number]) ["R" math/random] - (macro ["&" ast])) + (macro ["&" code])) lux/test) -(test: "AST" +(test: "Code" (with-expansions [<tests> (do-template [<expr> <text>] - [(assert (format "Can produce AST node: " <text>) + [(assert (format "Can produce Code node: " <text>) (and (T/= <text> (&;to-text <expr>)) - (:: &;Eq<AST> = <expr> <expr>)))] + (:: &;Eq<Code> = <expr> <expr>)))] [(&;bool true) "true"] [(&;bool false) "false"] diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index 41c372e15..f75a7117e 100644 --- a/stdlib/test/test/lux/macro/syntax.lux +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -12,13 +12,13 @@ [error #- fail]) ["R" math/random] [macro] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax])) lux/test) ## [Utils] (def: (enforced? parser input) - (-> (Syntax []) (List AST) Bool) + (-> (Syntax []) (List Code) Bool) (case (s;run input parser) (#;Right [_ []]) true @@ -27,7 +27,7 @@ false)) (def: (found? parser input) - (-> (Syntax Bool) (List AST) Bool) + (-> (Syntax Bool) (List Code) Bool) (case (s;run input parser) (#;Right [_ true]) true @@ -36,7 +36,7 @@ false)) (def: (is? Eq<a> test parser input) - (All [a] (-> (Eq a) a (Syntax a) (List AST) Bool)) + (All [a] (-> (Eq a) a (Syntax a) (List Code) Bool)) (case (s;run input parser) (#;Right [_ output]) (:: Eq<a> = test output) @@ -70,31 +70,31 @@ (found? (s;this? (<ctor> <value>)) (list (<ctor> <value>))) (enforced? (s;this! (<ctor> <value>)) (list (<ctor> <value>)))))] - ["Can parse Bool syntax." true ast;bool bool;Eq<Bool> s;bool] - ["Can parse Nat syntax." +123 ast;nat number;Eq<Nat> s;nat] - ["Can parse Int syntax." 123 ast;int number;Eq<Int> s;int] - ["Can parse Deg syntax." .123 ast;deg number;Eq<Deg> s;deg] - ["Can parse Real syntax." 123.0 ast;real number;Eq<Real> s;real] - ["Can parse Char syntax." #"\n" ast;char char;Eq<Char> s;char] - ["Can parse Text syntax." "\n" ast;text text;Eq<Text> s;text] - ["Can parse Symbol syntax." ["yolo" "lol"] ast;symbol ident;Eq<Ident> s;symbol] - ["Can parse Tag syntax." ["yolo" "lol"] ast;tag ident;Eq<Ident> s;tag] + ["Can parse Bool syntax." true code;bool bool;Eq<Bool> s;bool] + ["Can parse Nat syntax." +123 code;nat number;Eq<Nat> s;nat] + ["Can parse Int syntax." 123 code;int number;Eq<Int> s;int] + ["Can parse Deg syntax." .123 code;deg number;Eq<Deg> s;deg] + ["Can parse Real syntax." 123.0 code;real number;Eq<Real> s;real] + ["Can parse Char syntax." #"\n" code;char char;Eq<Char> s;char] + ["Can parse Text syntax." "\n" code;text text;Eq<Text> s;text] + ["Can parse Symbol syntax." ["yolo" "lol"] code;symbol ident;Eq<Ident> s;symbol] + ["Can parse Tag syntax." ["yolo" "lol"] code;tag ident;Eq<Ident> s;tag] )] ($_ seq <simple-tests> (assert "Can parse symbols belonging to the current namespace." (and (match "yolo" - (s;run (list (ast;local-symbol "yolo")) + (s;run (list (code;local-symbol "yolo")) s;local-symbol)) - (fails? (s;run (list (ast;symbol ["yolo" "lol"])) + (fails? (s;run (list (code;symbol ["yolo" "lol"])) s;local-symbol)))) (assert "Can parse tags belonging to the current namespace." (and (match "yolo" - (s;run (list (ast;local-tag "yolo")) + (s;run (list (code;local-tag "yolo")) s;local-tag)) - (fails? (s;run (list (ast;tag ["yolo" "lol"])) + (fails? (s;run (list (code;tag ["yolo" "lol"])) s;local-tag)))) ))) @@ -103,89 +103,89 @@ [<group-tests> (do-template [<type> <parser> <ctor>] [(assert (format "Can parse " <type> " syntax.") (and (match [true 123] - (s;run (list (<ctor> (list (ast;bool true) (ast;int 123)))) + (s;run (list (<ctor> (list (code;bool true) (code;int 123)))) (<parser> (s;seq s;bool s;int)))) (match true - (s;run (list (<ctor> (list (ast;bool true)))) + (s;run (list (<ctor> (list (code;bool true)))) (<parser> s;bool))) - (fails? (s;run (list (<ctor> (list (ast;bool true) (ast;int 123)))) + (fails? (s;run (list (<ctor> (list (code;bool true) (code;int 123)))) (<parser> s;bool))) (match (#;Left true) - (s;run (list (<ctor> (list (ast;bool true)))) + (s;run (list (<ctor> (list (code;bool true)))) (<parser> (s;alt s;bool s;int)))) (match (#;Right 123) - (s;run (list (<ctor> (list (ast;int 123)))) + (s;run (list (<ctor> (list (code;int 123)))) (<parser> (s;alt s;bool s;int)))) - (fails? (s;run (list (<ctor> (list (ast;real 123.0)))) + (fails? (s;run (list (<ctor> (list (code;real 123.0)))) (<parser> (s;alt s;bool s;int))))))] - ["form" s;form ast;form] - ["tuple" s;tuple ast;tuple])] + ["form" s;form code;form] + ["tuple" s;tuple code;tuple])] ($_ seq <group-tests> (assert "Can parse record syntax." (match [true 123] - (s;run (list (ast;record (list [(ast;bool true) (ast;int 123)]))) + (s;run (list (code;record (list [(code;bool true) (code;int 123)]))) (s;record (s;seq s;bool s;int))))) ))) (test: "Assertions" (assert "Can make assertions while parsing." (and (match [] - (s;run (list (ast;bool true) (ast;int 123)) + (s;run (list (code;bool true) (code;int 123)) (s;assert "yolo" true))) - (fails? (s;run (list (ast;bool true) (ast;int 123)) + (fails? (s;run (list (code;bool true) (code;int 123)) (s;assert "yolo" false)))))) (test: "Combinators [Part 1]" ($_ seq - (assert "Can parse any AST." + (assert "Can parse any Code." (match [_ (#;Bool true)] - (s;run (list (ast;bool true) (ast;int 123)) + (s;run (list (code;bool true) (code;int 123)) s;any))) (assert "Can optionally succeed with some parser." (and (match (#;Some +123) - (s;run (list (ast;nat +123)) + (s;run (list (code;nat +123)) (s;opt s;nat))) (match #;None - (s;run (list (ast;int -123)) + (s;run (list (code;int -123)) (s;opt s;nat))))) (assert "Can apply a parser 0 or more times." (and (match (list +123 +456 +789) - (s;run (list (ast;nat +123) (ast;nat +456) (ast;nat +789)) + (s;run (list (code;nat +123) (code;nat +456) (code;nat +789)) (s;some s;nat))) (match (list) - (s;run (list (ast;int -123)) + (s;run (list (code;int -123)) (s;some s;nat))))) (assert "Can apply a parser 1 or more times." (and (match (list +123 +456 +789) - (s;run (list (ast;nat +123) (ast;nat +456) (ast;nat +789)) + (s;run (list (code;nat +123) (code;nat +456) (code;nat +789)) (s;many s;nat))) (match (list +123) - (s;run (list (ast;nat +123)) + (s;run (list (code;nat +123)) (s;many s;nat))) - (fails? (s;run (list (ast;int -123)) + (fails? (s;run (list (code;int -123)) (s;many s;nat))))) (assert "Can use either parser." (and (match 123 - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;run (list (code;int 123) (code;int 456) (code;int 789)) (s;either s;pos-int s;int))) (match -123 - (s;run (list (ast;int -123) (ast;int 456) (ast;int 789)) + (s;run (list (code;int -123) (code;int 456) (code;int 789)) (s;either s;pos-int s;int))) - (fails? (s;run (list (ast;bool true) (ast;int 456) (ast;int 789)) + (fails? (s;run (list (code;bool true) (code;int 456) (code;int 789)) (s;either s;pos-int s;int))))) (assert "Can create the opposite/negation of any parser." - (and (fails? (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (and (fails? (s;run (list (code;int 123) (code;int 456) (code;int 789)) (s;not s;int))) (match [] - (s;run (list (ast;bool true) (ast;int 456) (ast;int 789)) + (s;run (list (code;bool true) (code;int 456) (code;int 789)) (s;not s;int))))) )) @@ -196,59 +196,59 @@ (s;run (list) s;end?)) (match false - (s;run (list (ast;bool true)) + (s;run (list (code;bool true)) s;end?)))) (assert "Can ensure the end has been reached." (and (match [] (s;run (list) s;end!)) - (fails? (s;run (list (ast;bool true)) + (fails? (s;run (list (code;bool true)) s;end!)))) (assert "Can apply a parser N times." (and (match (list 123 456 789) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;run (list (code;int 123) (code;int 456) (code;int 789)) (s;exactly +3 s;int))) (match (list 123 456) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;run (list (code;int 123) (code;int 456) (code;int 789)) (s;exactly +2 s;int))) - (fails? (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (fails? (s;run (list (code;int 123) (code;int 456) (code;int 789)) (s;exactly +4 s;int))))) (assert "Can apply a parser at-least N times." (and (match (list 123 456 789) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;run (list (code;int 123) (code;int 456) (code;int 789)) (s;at-least +3 s;int))) (match (list 123 456 789) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;run (list (code;int 123) (code;int 456) (code;int 789)) (s;at-least +2 s;int))) - (fails? (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (fails? (s;run (list (code;int 123) (code;int 456) (code;int 789)) (s;at-least +4 s;int))))) (assert "Can apply a parser at-most N times." (and (match (list 123 456 789) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;run (list (code;int 123) (code;int 456) (code;int 789)) (s;at-most +3 s;int))) (match (list 123 456) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;run (list (code;int 123) (code;int 456) (code;int 789)) (s;at-most +2 s;int))) (match (list 123 456 789) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;run (list (code;int 123) (code;int 456) (code;int 789)) (s;at-most +4 s;int))))) (assert "Can apply a parser between N and M times." (and (match (list 123 456 789) - (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;run (list (code;int 123) (code;int 456) (code;int 789)) (s;between +3 +10 s;int))) - (fails? (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (fails? (s;run (list (code;int 123) (code;int 456) (code;int 789)) (s;between +4 +10 s;int))))) (assert "Can parse while taking separators into account." (and (match (list 123 456 789) - (s;run (list (ast;int 123) (ast;text "YOLO") (ast;int 456) (ast;text "YOLO") (ast;int 789)) + (s;run (list (code;int 123) (code;text "YOLO") (code;int 456) (code;text "YOLO") (code;int 789)) (s;sep-by (s;this! (' "YOLO")) s;int))) (match (list 123 456) - (s;run (list (ast;int 123) (ast;text "YOLO") (ast;int 456) (ast;int 789)) + (s;run (list (code;int 123) (code;text "YOLO") (code;int 456) (code;int 789)) (s;sep-by (s;this! (' "YOLO")) s;int))))) )) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 4cb00c4a7..2b24bd70e 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -15,12 +15,14 @@ ["_;" promise] ["_;" stm]) (control ["_;" effect] + ["_;" exception] ["_;" interval] ["_;" pipe] ["_;" cont] ["_;" reader] ["_;" state] - ["_;" thunk]) + ["_;" thunk] + ) (data ["_;" bit] ["_;" bool] ["_;" char] @@ -35,7 +37,6 @@ ["_;" product] ["_;" sum] ["_;" text] - (error ["_;" exception]) (format ["_;" json] ["_;" xml]) (coll ["_;" array] @@ -50,15 +51,17 @@ ["_;" zipper]) ["_;" seq] ["_;" priority-queue] - ["_;" stream]) + ["_;" stream] + ) (text ["_;" format] ["_;" lexer] - ["_;" regex])) + ["_;" regex]) + ) ["_;" math] (math ["_;" simple] (logic ["_;" continuous] ["_;" fuzzy])) - (macro ["_;" ast] + (macro ["_;" code] ["_;" syntax] (poly ["poly_;" eq] ["poly_;" text-encoder] @@ -66,7 +69,8 @@ ["_;" type] (type ["_;" check] ["_;" auto]) - )) + ) + ) (lux (control [contract]) (data [env] [trace] |