From f8c2389db4a9b3239b00b9d209237d5116e12e3c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 25 Jan 2017 07:02:33 -0400 Subject: - Renamed lux/data/struct/tree to lux/data/struct/tree/rose. - Moved lux/data/struct/zipper to lux/data/struct/tree/zipper. - Moved lux/regex to lux/lexer/regex. - Changed the suffix of annotation tags, from M to A. - Renamed Frac(tional) numbers to Deg(rees). --- stdlib/source/lux.lux | 412 +++++++++++++++++++++++++------------------------- 1 file changed, 206 insertions(+), 206 deletions(-) (limited to 'stdlib/source/lux.lux') diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 76093eb29..bb53b987e 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -38,9 +38,9 @@ (+1 [["lux" "doc"] (+6 "Your standard, run-of-the-mill floating-point numbers.")] (+0))))) -(_lux_def Frac - (+12 ["lux" "Frac"] - (+0 "#Frac" (+0))) +(_lux_def Deg + (+12 ["lux" "Deg"] + (+0 "#Deg" (+0))) (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] (+1 [["lux" "doc"] (+6 "Fractional numbers that live in the interval [0,1). @@ -221,56 +221,56 @@ #Nil)))) ## (type: #rec Ann-Value -## (#BoolM Bool) -## (#NatM Nat) -## (#IntM Int) -## (#FracM Frac) -## (#RealM Real) -## (#CharM Char) -## (#TextM Text) -## (#IdentM Ident) -## (#ListM (List Ann-Value)) -## (#DictM (List [Text Ann-Value]))) +## (#BoolA Bool) +## (#NatA Nat) +## (#IntA Int) +## (#DegA Deg) +## (#RealA Real) +## (#CharA Char) +## (#TextA Text) +## (#IdentA Ident) +## (#ListA (List Ann-Value)) +## (#DictA (List [Text Ann-Value]))) (_lux_def Ann-Value (#NamedT ["lux" "Ann-Value"] (_lux_case (#AppT (#BoundT +0) (#BoundT +1)) Ann-Value (#AppT (#UnivQ #Nil - (#SumT ## #BoolM + (#SumT ## #BoolA Bool - (#SumT ## #NatM + (#SumT ## #NatA Nat - (#SumT ## #IntM + (#SumT ## #IntA Int - (#SumT ## #FracM - Frac - (#SumT ## #RealM + (#SumT ## #DegA + Deg + (#SumT ## #RealA Real - (#SumT ## #CharM + (#SumT ## #CharA Char - (#SumT ## #TextM + (#SumT ## #TextA Text - (#SumT ## #IdentM + (#SumT ## #IdentA Ident - (#SumT ## #ListM + (#SumT ## #ListA (#AppT List Ann-Value) - ## #DictM + ## #DictA (#AppT List (#ProdT Text Ann-Value))))))))))) ) Void) )) (#Cons [["lux" "type?"] (+0 true)] (#Cons [["lux" "export?"] (+0 true)] - (#Cons [["lux" "tags"] (+8 (#Cons (+6 "BoolM") - (#Cons (+6 "NatM") - (#Cons (+6 "IntM") - (#Cons (+6 "FracM") - (#Cons (+6 "RealM") - (#Cons (+6 "CharM") - (#Cons (+6 "TextM") - (#Cons (+6 "IdentM") - (#Cons (+6 "ListM") - (#Cons (+6 "DictM") + (#Cons [["lux" "tags"] (+8 (#Cons (+6 "BoolA") + (#Cons (+6 "NatA") + (#Cons (+6 "IntA") + (#Cons (+6 "DegA") + (#Cons (+6 "RealA") + (#Cons (+6 "CharA") + (#Cons (+6 "TextA") + (#Cons (+6 "IdentA") + (#Cons (+6 "ListA") + (#Cons (+6 "DictA") #Nil)))))))))))] (#Cons [["lux" "type-rec?"] (+0 true)] (#Cons [["lux" "doc"] (+6 "The value of an individual annotation.")] @@ -281,21 +281,21 @@ (_lux_def Anns (#NamedT ["lux" "Anns"] (#AppT List (#ProdT Ident Ann-Value))) - (#Cons [["lux" "type?"] (#BoolM true)] - (#Cons [["lux" "export?"] (#BoolM true)] - (#Cons [["lux" "doc"] (#TextM "A set of annotations associated with a definition.")] + (#Cons [["lux" "type?"] (#BoolA true)] + (#Cons [["lux" "export?"] (#BoolA true)] + (#Cons [["lux" "doc"] (#TextA "A set of annotations associated with a definition.")] #Nil)))) (_lux_def default-def-meta-exported (_lux_: Anns - (#Cons [["lux" "type?"] (#BoolM true)] - (#Cons [["lux" "export?"] (#BoolM true)] + (#Cons [["lux" "type?"] (#BoolA true)] + (#Cons [["lux" "export?"] (#BoolA true)] #Nil))) #Nil) (_lux_def default-def-meta-unexported (_lux_: Anns - (#Cons [["lux" "type?"] (#BoolM true)] + (#Cons [["lux" "type?"] (#BoolA true)] #Nil)) #Nil) @@ -304,7 +304,7 @@ (_lux_def Def (#NamedT ["lux" "Def"] (#ProdT Type (#ProdT Anns Void))) - (#Cons [["lux" "doc"] (#TextM "Represents all the data associated with a definition: its type, its annotations, and its value.")] + (#Cons [["lux" "doc"] (#TextA "Represents all the data associated with a definition: its type, its annotations, and its value.")] default-def-meta-exported)) ## (type: (Bindings k v) @@ -320,10 +320,10 @@ (#AppT List (#ProdT (#BoundT +3) (#BoundT +1))))))) - (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "counter") - (#Cons (#TextM "mappings") + (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "counter") + (#Cons (#TextA "mappings") #Nil)))] - (#Cons [["lux" "type-args"] (#ListM (#Cons (#TextM "k") (#Cons (#TextM "v") #;Nil)))] + (#Cons [["lux" "type-args"] (#ListA (#Cons (#TextA "k") (#Cons (#TextA "v") #;Nil)))] default-def-meta-exported))) ## (type: Cursor @@ -333,11 +333,11 @@ (_lux_def Cursor (#NamedT ["lux" "Cursor"] (#ProdT Text (#ProdT Int Int))) - (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "module") - (#Cons (#TextM "line") - (#Cons (#TextM "column") + (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "module") + (#Cons (#TextA "line") + (#Cons (#TextA "column") #Nil))))] - (#Cons [["lux" "doc"] (#TextM "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 AST nodes in Lux files during compilation.")] default-def-meta-exported))) ## (type: (Meta m v) @@ -349,11 +349,11 @@ (#UnivQ #Nil (#ProdT (#BoundT +3) (#BoundT +1))))) - (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "meta") - (#Cons (#TextM "datum") + (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "meta") + (#Cons (#TextA "datum") #Nil)))] - (#Cons [["lux" "doc"] (#TextM "The type of things that can have meta-data of arbitrary types.")] - (#Cons [["lux" "type-args"] (#ListM (#Cons (#TextM "m") (#Cons (#TextM "v") #;Nil)))] + (#Cons [["lux" "doc"] (#TextA "The type of things that can have meta-data of arbitrary types.")] + (#Cons [["lux" "type-args"] (#ListA (#Cons (#TextA "m") (#Cons (#TextA "v") #;Nil)))] default-def-meta-exported)))) (_lux_def Analysis @@ -378,10 +378,10 @@ (#AppT (#AppT Bindings Text) Analysis) ## "lux;closure" (#AppT (#AppT Bindings Text) Analysis))))) - (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "name") - (#Cons (#TextM "inner-closures") - (#Cons (#TextM "locals") - (#Cons (#TextM "closure") + (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "name") + (#Cons (#TextA "inner-closures") + (#Cons (#TextA "locals") + (#Cons (#TextA "closure") #Nil)))))] default-def-meta-exported)) @@ -389,7 +389,7 @@ ## (#BoolS Bool) ## (#NatS Nat) ## (#IntS Int) -## (#FracS Frac) +## (#DegS Deg) ## (#RealS Real) ## (#CharS Char) ## (#TextS Text) @@ -413,8 +413,8 @@ Nat (#SumT ## "lux;IntS" Int - (#SumT ## "lux;FracS" - Frac + (#SumT ## "lux;DegS" + Deg (#SumT ## "lux;RealS" Real (#SumT ## "lux;CharS" @@ -433,20 +433,20 @@ (#AppT List (#ProdT AST AST)) ))))))))))) )))) - (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "BoolS") - (#Cons (#TextM "NatS") - (#Cons (#TextM "IntS") - (#Cons (#TextM "FracS") - (#Cons (#TextM "RealS") - (#Cons (#TextM "CharS") - (#Cons (#TextM "TextS") - (#Cons (#TextM "SymbolS") - (#Cons (#TextM "TagS") - (#Cons (#TextM "FormS") - (#Cons (#TextM "TupleS") - (#Cons (#TextM "RecordS") + (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "BoolS") + (#Cons (#TextA "NatS") + (#Cons (#TextA "IntS") + (#Cons (#TextA "DegS") + (#Cons (#TextA "RealS") + (#Cons (#TextA "CharS") + (#Cons (#TextA "TextS") + (#Cons (#TextA "SymbolS") + (#Cons (#TextA "TagS") + (#Cons (#TextA "FormS") + (#Cons (#TextA "TupleS") + (#Cons (#TextA "RecordS") #Nil)))))))))))))] - (#Cons [["lux" "type-args"] (#ListM (#Cons (#TextM "w") #;Nil))] + (#Cons [["lux" "type-args"] (#ListA (#Cons (#TextA "w") #;Nil))] default-def-meta-exported))) ## (type: AST @@ -456,7 +456,7 @@ (_lux_case (#AppT Meta Cursor) w (#AppT w (#AppT AST' w)))) - (#Cons [["lux" "doc"] (#TextM "The type of AST nodes for Lux syntax.")] + (#Cons [["lux" "doc"] (#TextA "The type of AST nodes for Lux syntax.")] default-def-meta-exported)) (_lux_def ASTList @@ -474,11 +474,11 @@ (#BoundT +3) ## "lux;Right" (#BoundT +1))))) - (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "Left") - (#Cons (#TextM "Right") + (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Left") + (#Cons (#TextA "Right") #Nil)))] - (#Cons [["lux" "type-args"] (#ListM (#Cons (#TextM "l") (#Cons (#TextM "r") #;Nil)))] - (#Cons [["lux" "doc"] (#TextM "A choice between two values of different types.")] + (#Cons [["lux" "type-args"] (#ListA (#Cons (#TextA "l") (#Cons (#TextA "r") #;Nil)))] + (#Cons [["lux" "doc"] (#TextA "A choice between two values of different types.")] default-def-meta-exported)))) ## (type: Source @@ -526,15 +526,15 @@ ## "lux;module-anns" Anns) )))))) - (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "module-hash") - (#Cons (#TextM "module-aliases") - (#Cons (#TextM "defs") - (#Cons (#TextM "imports") - (#Cons (#TextM "tags") - (#Cons (#TextM "types") - (#Cons (#TextM "module-anns") + (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "module-hash") + (#Cons (#TextA "module-aliases") + (#Cons (#TextA "defs") + (#Cons (#TextA "imports") + (#Cons (#TextA "tags") + (#Cons (#TextA "types") + (#Cons (#TextA "module-anns") #Nil))))))))] - (#Cons [["lux" "doc"] (#TextM "All the information contained within a Lux module.")] + (#Cons [["lux" "doc"] (#TextA "All the information contained within a Lux module.")] default-def-meta-exported))) ## (type: Compiler-Mode @@ -552,12 +552,12 @@ #UnitT ## "lux;REPL" #UnitT)))) - (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "Release") - (#Cons (#TextM "Debug") - (#Cons (#TextM "Eval") - (#Cons (#TextM "REPL") + (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Release") + (#Cons (#TextA "Debug") + (#Cons (#TextA "Eval") + (#Cons (#TextA "REPL") #Nil)))))] - (#Cons [["lux" "doc"] (#TextM "A sign that shows the conditions under which the compiler is running.")] + (#Cons [["lux" "doc"] (#TextA "A sign that shows the conditions under which the compiler is running.")] default-def-meta-exported))) ## (type: Compiler-Info @@ -572,11 +572,11 @@ Text ## "lux;compiler-mode" Compiler-Mode))) - (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "compiler-name") - (#Cons (#TextM "compiler-version") - (#Cons (#TextM "compiler-mode") + (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "compiler-name") + (#Cons (#TextA "compiler-version") + (#Cons (#TextA "compiler-mode") #Nil))))] - (#Cons [["lux" "doc"] (#TextM "Information about the current version and type of compiler that is running.")] + (#Cons [["lux" "doc"] (#TextA "Information about the current version and type of compiler that is running.")] default-def-meta-exported))) ## (type: Compiler @@ -613,18 +613,18 @@ (#AppT List Nat) ## "lux;host" Void)))))))))) - (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "info") - (#Cons (#TextM "source") - (#Cons (#TextM "cursor") - (#Cons (#TextM "modules") - (#Cons (#TextM "scopes") - (#Cons (#TextM "type-vars") - (#Cons (#TextM "expected") - (#Cons (#TextM "seed") - (#Cons (#TextM "scope-type-vars") - (#Cons (#TextM "host") + (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "info") + (#Cons (#TextA "source") + (#Cons (#TextA "cursor") + (#Cons (#TextA "modules") + (#Cons (#TextA "scopes") + (#Cons (#TextA "type-vars") + (#Cons (#TextA "expected") + (#Cons (#TextA "seed") + (#Cons (#TextA "scope-type-vars") + (#Cons (#TextA "host") #Nil)))))))))))] - (#Cons [["lux" "doc"] (#TextM "Represents the state of the Lux compiler during a run. + (#Cons [["lux" "doc"] (#TextA "Represents the state of the Lux compiler during a run. It is provided to macros during their invocation, so they can access compiler data. @@ -639,10 +639,10 @@ (#LambdaT Compiler (#AppT (#AppT Either Text) (#ProdT Compiler (#BoundT +1)))))) - (#Cons [["lux" "doc"] (#TextM "Computations that can have access to the state of the compiler. + (#Cons [["lux" "doc"] (#TextA "Computations that can have access to the state of the compiler. These computations may fail, or modify the state of the compiler.")] - (#Cons [["lux" "type-args"] (#ListM (#Cons (#TextM "a") #;Nil))] + (#Cons [["lux" "type-args"] (#ListA (#Cons (#TextA "a") #;Nil))] default-def-meta-exported))) ## (type: Macro @@ -650,7 +650,7 @@ (_lux_def Macro (#NamedT ["lux" "Macro"] (#LambdaT ASTList (#AppT Lux ASTList))) - (#Cons [["lux" "doc"] (#TextM "Functions that run at compile-time and allow you to transform and extend the language in powerful ways.")] + (#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)) ## Base functions & macros @@ -721,9 +721,9 @@ (_lux_lambda _ value (_meta (#IntS value)))) #Nil) -(_lux_def frac$ - (_lux_: (#LambdaT Frac AST) - (_lux_lambda _ value (_meta (#FracS value)))) +(_lux_def deg$ + (_lux_: (#LambdaT Deg AST) + (_lux_lambda _ value (_meta (#DegS value)))) #Nil) (_lux_def real$ @@ -768,7 +768,7 @@ (_lux_def default-macro-meta (_lux_: Anns - (#Cons [["lux" "macro?"] (#BoolM true)] + (#Cons [["lux" "macro?"] (#BoolA true)] #Nil)) #Nil) @@ -826,7 +826,7 @@ (_lux_def export?-meta (_lux_: AST (tuple$ (#Cons [(tuple$ (#Cons [(text$ "lux") (#Cons [(text$ "export?") #Nil])])) - (#Cons [(form$ (#Cons [(tag$ ["lux" "BoolM"]) + (#Cons [(form$ (#Cons [(tag$ ["lux" "BoolA"]) (#Cons [(bool$ true) #Nil])])) #Nil])]))) @@ -835,7 +835,7 @@ (_lux_def hidden?-meta (_lux_: AST (tuple$ (#Cons [(tuple$ (#Cons [(text$ "lux") (#Cons [(text$ "hidden?") #Nil])])) - (#Cons [(form$ (#Cons [(tag$ ["lux" "BoolM"]) + (#Cons [(form$ (#Cons [(tag$ ["lux" "BoolA"]) (#Cons [(bool$ true) #Nil])])) #Nil])]))) @@ -844,7 +844,7 @@ (_lux_def macro?-meta (_lux_: AST (tuple$ (#Cons [(tuple$ (#Cons [(text$ "lux") (#Cons [(text$ "macro?") #Nil])])) - (#Cons [(form$ (#Cons [(tag$ ["lux" "BoolM"]) + (#Cons [(form$ (#Cons [(tag$ ["lux" "BoolA"]) (#Cons [(bool$ true) #Nil])])) #Nil])]))) @@ -972,7 +972,7 @@ (fail "Wrong syntax for macro:'"))) (macro:' #export (comment tokens) - (#Cons [["lux" "doc"] (#TextM "## Throws away any code given to it. + (#Cons [["lux" "doc"] (#TextA "## Throws away any code given to it. ## Great for commenting-out code, while retaining syntax high-lighting and formatting in your text editor. (comment 1 2 3 4)")] #;Nil) @@ -1141,7 +1141,7 @@ (fold (lambda'' [_ acc] (_lux_proc ["jvm" "ladd"] [1 acc])) 0 list)) (macro:' #export (All tokens) - (#Cons [["lux" "doc"] (#TextM "## Universal quantification. + (#Cons [["lux" "doc"] (#TextA "## Universal quantification. (All [a] (-> a a)) @@ -1190,7 +1190,7 @@ )) (macro:' #export (Ex tokens) - (#Cons [["lux" "doc"] (#TextM "## Existential quantification. + (#Cons [["lux" "doc"] (#TextA "## Existential quantification. (Ex [a] [(Codec Text a) a]) @@ -1248,7 +1248,7 @@ list)) (macro:' #export (-> tokens) - (#Cons [["lux" "doc"] (#TextM "## Function types: + (#Cons [["lux" "doc"] (#TextA "## Function types: (-> Int Int Int) ## This is the type of a function that takes 2 Ints and returns an Int.")] @@ -1265,7 +1265,7 @@ (fail "Wrong syntax for ->"))) (macro:' #export (list xs) - (#Cons [["lux" "doc"] (#TextM "## List-construction macro. + (#Cons [["lux" "doc"] (#TextA "## List-construction macro. (list 1 2 3)")] #;Nil) (return (#Cons (fold (lambda'' [head tail] @@ -1277,7 +1277,7 @@ #Nil))) (macro:' #export (list& xs) - (#Cons [["lux" "doc"] (#TextM "## List-construction macro, with the last element being a tail-list. + (#Cons [["lux" "doc"] (#TextA "## List-construction macro, with the last element being a tail-list. ## In other words, this macro prepends elements to another list. (list& 1 2 3 (list 4 5 6))")] #;Nil) @@ -1293,7 +1293,7 @@ (fail "Wrong syntax for list&"))) (macro:' #export (& tokens) - (#Cons [["lux" "doc"] (#TextM "## Tuple types: + (#Cons [["lux" "doc"] (#TextA "## Tuple types: (& Text Int Bool) ## The empty tuple, a.k.a. Unit. @@ -1310,7 +1310,7 @@ )) (macro:' #export (| tokens) - (#Cons [["lux" "doc"] (#TextM "## Variant types: + (#Cons [["lux" "doc"] (#TextA "## Variant types: (| Text Int Bool) ## The empty tuple, a.k.a. Void. @@ -1474,7 +1474,7 @@ ys)) (def:''' #export (splice-helper xs ys) - (#Cons [["lux" "hidden?"] (#BoolM true)] + (#Cons [["lux" "hidden?"] (#BoolA true)] #;Nil) (-> ($' List AST) ($' List AST) ($' List AST)) (_lux_case xs @@ -1485,7 +1485,7 @@ ys)) (macro:' #export (_$ tokens) - (#Cons [["lux" "doc"] (#TextM "## Left-association for the application of binary functions over variadic arguments. + (#Cons [["lux" "doc"] (#TextA "## Left-association for the application of binary functions over variadic arguments. (_$ Text/append \"Hello, \" name \".\\nHow are you?\") ## => @@ -1506,7 +1506,7 @@ (fail "Wrong syntax for _$"))) (macro:' #export ($_ tokens) - (#Cons [["lux" "doc"] (#TextM "## Right-association for the application of binary functions over variadic arguments. + (#Cons [["lux" "doc"] (#TextA "## Right-association for the application of binary functions over variadic arguments. ($_ Text/append \"Hello, \" name \".\\nHow are you?\") ## => @@ -1532,7 +1532,7 @@ ## (: (All [a b] (-> (-> a (m b)) (m a) (m b))) ## bind)) (def:''' Monad - (list& [["lux" "tags"] (#ListM (list (#TextM "wrap") (#TextM "bind")))] + (list& [["lux" "tags"] (#ListA (list (#TextA "wrap") (#TextA "bind")))] default-def-meta-unexported) Type (#NamedT ["lux" "Monad"] @@ -1621,7 +1621,7 @@ ))) (macro:' #export (if tokens) - (list [["lux" "doc"] (#TextM "Picks which expression to evaluate based on a boolean test value. + (list [["lux" "doc"] (#TextA "Picks which expression to evaluate based on a boolean test value. (if true \"Oh, yeah!\" @@ -1706,7 +1706,7 @@ (_lux_case (get name defs) (#Some [def-type def-meta def-value]) (_lux_case (get-meta ["lux" "alias"] def-meta) - (#Some (#IdentM real-name)) + (#Some (#IdentA real-name)) (#Right [state real-name]) _ @@ -1768,8 +1768,8 @@ [_ [_ (#IntS value)]] (return (wrap-meta (form$ (list (tag$ ["lux" "IntS"]) (int$ value))))) - [_ [_ (#FracS value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "FracS"]) (frac$ value))))) + [_ [_ (#DegS value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "DegS"]) (deg$ value))))) [_ [_ (#RealS value)]] (return (wrap-meta (form$ (list (tag$ ["lux" "RealS"]) (real$ value))))) @@ -1838,7 +1838,7 @@ )) (macro:' #export (host tokens) - (list [["lux" "doc"] (#TextM "## Macro to treat host-types as Lux-types. + (list [["lux" "doc"] (#TextA "## Macro to treat host-types as Lux-types. (host java.lang.Object) (host java.util.List [java.lang.Long])")]) @@ -1869,7 +1869,7 @@ ))) (macro:' #export (` tokens) - (list [["lux" "doc"] (#TextM "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. + (list [["lux" "doc"] (#TextA "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. ## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used. (` (def: (~ name) (lambda [(~@ args)] @@ -1885,7 +1885,7 @@ (fail "Wrong syntax for `"))) (macro:' #export (`' tokens) - (list [["lux" "doc"] (#TextM "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. + (list [["lux" "doc"] (#TextA "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. (`' (def: (~ name) (lambda [(~@ args)] (~ body))))")]) @@ -1899,7 +1899,7 @@ (fail "Wrong syntax for `"))) (macro:' #export (' tokens) - (list [["lux" "doc"] (#TextM "## Quotation as a macro. + (list [["lux" "doc"] (#TextA "## Quotation as a macro. (' \"YOLO\")")]) (_lux_case tokens (#Cons template #Nil) @@ -1911,7 +1911,7 @@ (fail "Wrong syntax for '"))) (macro:' #export (|> tokens) - (list [["lux" "doc"] (#TextM "## Piping macro. + (list [["lux" "doc"] (#TextA "## Piping macro. (|> elems (map ->Text) (interpose \" \") (fold Text/append \"\")) ## => @@ -1938,7 +1938,7 @@ (fail "Wrong syntax for |>"))) (macro:' #export (<| tokens) - (list [["lux" "doc"] (#TextM "## Reverse piping macro. + (list [["lux" "doc"] (#TextA "## Reverse piping macro. (<| (fold Text/append \"\") (interpose \" \") (map ->Text) elems) ## => @@ -1965,7 +1965,7 @@ (fail "Wrong syntax for <|"))) (def:''' #export (. f g) - (list [["lux" "doc"] (#TextM "Function composition.")]) + (list [["lux" "doc"] (#TextA "Function composition.")]) (All [a b c] (-> (-> b c) (-> a b) (-> a c))) (lambda' [x] (f (g x)))) @@ -2066,7 +2066,7 @@ (_lux_proc ["jvm" "invokevirtual:java.lang.Object:toString:"] [x])) (macro:' #export (do-template tokens) - (list [["lux" "doc"] (#TextM "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary. + (list [["lux" "doc"] (#TextA "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary. (do-template [ ] [(def: #export (-> Int Int) @@ -2097,29 +2097,29 @@ (do-template [ <=-name> <=> <<-doc> <<=-doc> <>-doc> <>=-doc>] [(def:''' #export (<=-name> test subject) - (list [["lux" "doc"] (#TextM )]) + (list [["lux" "doc"] (#TextA )]) (-> Bool) (_lux_proc [ <=>] [subject test])) (def:''' #export ( test subject) - (list [["lux" "doc"] (#TextM <<-doc>)]) + (list [["lux" "doc"] (#TextA <<-doc>)]) (-> Bool) (_lux_proc [ ] [subject test])) (def:''' #export ( test subject) - (list [["lux" "doc"] (#TextM <<=-doc>)]) + (list [["lux" "doc"] (#TextA <<=-doc>)]) (-> Bool) (if (_lux_proc [ ] [subject test]) true (_lux_proc [ <=>] [subject test]))) (def:''' #export ( test subject) - (list [["lux" "doc"] (#TextM <>-doc>)]) + (list [["lux" "doc"] (#TextA <>-doc>)]) (-> Bool) (_lux_proc [ ] [test subject])) (def:''' #export ( test subject) - (list [["lux" "doc"] (#TextM <>=-doc>)]) + (list [["lux" "doc"] (#TextA <>=-doc>)]) (-> Bool) (if (_lux_proc [ ] [test subject]) true @@ -2131,8 +2131,8 @@ [ Int "jvm" i.= "leq" i.< i.<= "llt" i.> i.>= "Integer equality." "Integer less-than." "Integer less-than-equal." "Integer greater-than." "Integer greater-than-equal."] - [Frac "frac" f.= "=" f.< f.<= "<" f.> f.>= - "Fractional equality." "Fractional less-than." "Fractional less-than-equal." "Fractional greater-than." "Fractional greater-than-equal."] + [Deg "deg" d.= "=" d.< d.<= "<" d.> d.>= + "Degree equality." "Degree less-than." "Degree less-than-equal." "Degree greater-than." "Degree greater-than-equal."] [Real "jvm" r.= "deq" r.< r.<= "dlt" r.> r.>= "Real equality." "Real less-than." "Real less-than-equal." "Real greater-than." "Real greater-than-equal."] @@ -2140,7 +2140,7 @@ (do-template [ ] [(def:''' #export ( param subject) - (list [["lux" "doc"] (#TextM )]) + (list [["lux" "doc"] (#TextA )]) (-> ) (_lux_proc [subject param]))] @@ -2156,11 +2156,11 @@ [ Int i./ ["jvm" "ldiv"] "Int(eger) division."] [ Int i.% ["jvm" "lrem"] "Int(eger) remainder."] - [Frac f.+ ["frac" "+"] "Frac(tional) addition."] - [Frac f.- ["frac" "-"] "Frac(tional) substraction."] - [Frac f.* ["frac" "*"] "Frac(tional) multiplication."] - [Frac f./ ["frac" "/"] "Frac(tional) division."] - [Frac f.% ["frac" "%"] "Frac(tional) remainder."] + [Deg d.+ ["deg" "+"] "Deg(ree) addition."] + [Deg d.- ["deg" "-"] "Deg(ree) substraction."] + [Deg d.* ["deg" "*"] "Deg(ree) multiplication."] + [Deg d./ ["deg" "/"] "Deg(ree) division."] + [Deg d.% ["deg" "%"] "Deg(ree) remainder."] [Real r.+ ["jvm" "dadd"] "Real addition."] [Real r.- ["jvm" "dsub"] "Real substraction."] @@ -2171,7 +2171,7 @@ (do-template [ ] [(def:''' #export ( left right) - (list [["lux" "doc"] (#TextM )]) + (list [["lux" "doc"] (#TextA )]) (-> ) (if ( right left) left @@ -2183,8 +2183,8 @@ [i.min Int i.< "Int(eger) minimum."] [i.max Int i.> "Int(eger) maximum."] - [f.min Frac f.< "Frac(tional) minimum."] - [f.max Frac f.> "Frac(tional) maximum."] + [d.min Deg d.< "Deg(ree) minimum."] + [d.max Deg d.> "Deg(ree) maximum."] [r.min Real r.< "Real minimum."] [r.max Real r.> "Real minimum."] @@ -2196,7 +2196,7 @@ (i.= 0 (i.% div n))) (def:''' #export (not x) - (list [["lux" "doc"] (#TextM "## Boolean negation. + (list [["lux" "doc"] (#TextA "## Boolean negation. (not true) == false @@ -2215,9 +2215,9 @@ (get name bindings))] (let' [[def-type def-meta def-value] (_lux_: Def gdef)] (_lux_case (get-meta ["lux" "macro?"] def-meta) - (#Some (#BoolM true)) + (#Some (#BoolA true)) (_lux_case (get-meta ["lux" "export?"] def-meta) - (#Some (#BoolM true)) + (#Some (#BoolA true)) (#Some (_lux_:! Macro def-value)) _ @@ -2227,7 +2227,7 @@ _ (_lux_case (get-meta ["lux" "alias"] def-meta) - (#Some (#IdentM [r-module r-name])) + (#Some (#IdentA [r-module r-name])) (find-macro' modules current-module r-module r-name) _ @@ -2400,7 +2400,7 @@ type)) (macro:' #export (type tokens) - (list [["lux" "doc"] (#TextM "## Takes a type expression and returns it's representation as data-structure. + (list [["lux" "doc"] (#TextA "## Takes a type expression and returns it's representation as data-structure. (type (All [a] (Maybe (List a))))")]) (_lux_case tokens (#Cons type #Nil) @@ -2417,7 +2417,7 @@ (fail "Wrong syntax for type"))) (macro:' #export (: tokens) - (list [["lux" "doc"] (#TextM "## The type-annotation macro. + (list [["lux" "doc"] (#TextA "## The type-annotation macro. (: (List Int) (list 1 2 3))")]) (_lux_case tokens (#Cons type (#Cons value #Nil)) @@ -2427,7 +2427,7 @@ (fail "Wrong syntax for :"))) (macro:' #export (:! tokens) - (list [["lux" "doc"] (#TextM "## The type-coercion macro. + (list [["lux" "doc"] (#TextA "## The type-coercion macro. (:! Dinosaur (list 1 2 3))")]) (_lux_case tokens (#Cons type (#Cons value #Nil)) @@ -2523,7 +2523,7 @@ (symbol$ ["" ($_ Text/append "__gensym__" prefix (->Text seed))])))) (macro:' #export (Rec tokens) - (list [["lux" "doc"] (#TextM "## Parameter-less recursive types. + (list [["lux" "doc"] (#TextA "## Parameter-less recursive types. ## A name has to be given to the whole type, to use it within it's body. (Rec Self [Int (List Self)])")]) @@ -2536,7 +2536,7 @@ (fail "Wrong syntax for Rec"))) (macro:' #export (exec tokens) - (list [["lux" "doc"] (#TextM "## Sequential execution of expressions (great for side-effects). + (list [["lux" "doc"] (#TextA "## Sequential execution of expressions (great for side-effects). (exec (log! \"#1\") (log! \"#2\") @@ -2608,10 +2608,10 @@ (-> Nat Text) (_lux_proc ["nat" "encode"] [x])) -(def:''' (Frac->Text x) +(def:''' (Deg->Text x) #Nil - (-> Frac Text) - (_lux_proc ["frac" "encode"] [x])) + (-> Deg Text) + (_lux_proc ["deg" "encode"] [x])) (def:' (ast-to-text ast) (-> AST Text) @@ -2625,8 +2625,8 @@ [_ (#IntS value)] (->Text value) - [_ (#FracS value)] - (Frac->Text value) + [_ (#DegS value)] + (Deg->Text value) [_ (#RealS value)] (->Text value) @@ -2703,7 +2703,7 @@ (fold Text/append "")))))) (macro:' #export (case tokens) - (list [["lux" "doc"] (#TextM "## The pattern-matching macro. + (list [["lux" "doc"] (#TextA "## The pattern-matching macro. ## Allows the usage of macros within the patterns to provide custom syntax. (case (: (List Int) (list 1 2 3)) (#Cons x (#Cons y (#Cons z #Nil))) @@ -2721,7 +2721,7 @@ (fail "Wrong syntax for case"))) (macro:' #export (^ tokens) - (list [["lux" "doc"] (#TextM "## Macro-expanding patterns. + (list [["lux" "doc"] (#TextA "## Macro-expanding patterns. ## It's a special macro meant to be used with 'case'. (case (: (List Int) (list 1 2 3)) (^ (list x y z)) @@ -2744,7 +2744,7 @@ (fail "Wrong syntax for ^ macro"))) (macro:' #export (^or tokens) - (list [["lux" "doc"] (#TextM "## Or-patterns. + (list [["lux" "doc"] (#TextA "## Or-patterns. ## It's a special macro meant to be used with 'case'. (type: Weekday #Monday @@ -2787,7 +2787,7 @@ false)) (macro:' #export (let tokens) - (list [["lux" "doc"] (#TextM "## Creates local bindings. + (list [["lux" "doc"] (#TextA "## Creates local bindings. ## Can (optionally) use pattern-matching macros when binding. (let [x (foo bar) y (baz quux)] @@ -2811,7 +2811,7 @@ (fail "Wrong syntax for let"))) (macro:' #export (lambda tokens) - (list [["lux" "doc"] (#TextM "## Syntax for creating functions. + (list [["lux" "doc"] (#TextA "## Syntax for creating functions. ## Allows for giving the function itself a name, for the sake of recursion. (: (All [a b] (-> a b a)) (lambda [x y] x)) @@ -2850,28 +2850,28 @@ (-> AST (Lux AST)) (case ast [_ (#BoolS value)] - (return (form$ (list (tag$ ["lux" "BoolM"]) (bool$ value)))) + (return (form$ (list (tag$ ["lux" "BoolA"]) (bool$ value)))) [_ (#NatS value)] - (return (form$ (list (tag$ ["lux" "NatM"]) (nat$ value)))) + (return (form$ (list (tag$ ["lux" "NatA"]) (nat$ value)))) [_ (#IntS value)] - (return (form$ (list (tag$ ["lux" "IntM"]) (int$ value)))) + (return (form$ (list (tag$ ["lux" "IntA"]) (int$ value)))) - [_ (#FracS value)] - (return (form$ (list (tag$ ["lux" "FracM"]) (frac$ value)))) + [_ (#DegS value)] + (return (form$ (list (tag$ ["lux" "DegA"]) (deg$ value)))) [_ (#RealS value)] - (return (form$ (list (tag$ ["lux" "RealM"]) (real$ value)))) + (return (form$ (list (tag$ ["lux" "RealA"]) (real$ value)))) [_ (#CharS value)] - (return (form$ (list (tag$ ["lux" "CharM"]) (char$ value)))) + (return (form$ (list (tag$ ["lux" "CharA"]) (char$ value)))) [_ (#TextS value)] - (return (form$ (list (tag$ ["lux" "TextM"]) (text$ value)))) + (return (form$ (list (tag$ ["lux" "TextA"]) (text$ value)))) [_ (#TagS [prefix name])] - (return (form$ (list (tag$ ["lux" "IdentM"]) (tuple$ (list (text$ prefix) (text$ name)))))) + (return (form$ (list (tag$ ["lux" "IdentA"]) (tuple$ (list (text$ prefix) (text$ name)))))) (^or [_ (#FormS _)] [_ (#SymbolS _)]) (return ast) @@ -2879,7 +2879,7 @@ [_ (#TupleS xs)] (do Monad [=xs (mapM Monad process-def-meta-value xs)] - (wrap (form$ (list (tag$ ["lux" "ListM"]) (untemplate-list =xs))))) + (wrap (form$ (list (tag$ ["lux" "ListA"]) (untemplate-list =xs))))) [_ (#RecordS kvs)] (do Monad @@ -2893,9 +2893,9 @@ (wrap (tuple$ (list (text$ =k) =v)))) _ - (fail (Text/append "Wrong syntax for DictM key: " (ast-to-text k)))))) + (fail (Text/append "Wrong syntax for DictA key: " (ast-to-text k)))))) kvs)] - (wrap (form$ (list (tag$ ["lux" "DictM"]) (untemplate-list =xs))))) + (wrap (form$ (list (tag$ ["lux" "DictA"]) (untemplate-list =xs))))) )) (def:' (process-def-meta ast) @@ -2929,15 +2929,15 @@ _ (` (#;Cons [["lux" "func-args"] - (#;ListM (list (~@ (map (lambda [arg] - (` (#;TextM (~ (text$ (ast-to-text arg)))))) + (#;ListA (list (~@ (map (lambda [arg] + (` (#;TextA (~ (text$ (ast-to-text arg)))))) args))))] (~ meta))))) (def:' (with-type-args args) (-> (List AST) AST) - (` {#;type-args (#;ListM (list (~@ (map (lambda [arg] - (` (#;TextM (~ (text$ (ast-to-text arg)))))) + (` {#;type-args (#;ListA (list (~@ (map (lambda [arg] + (` (#;TextA (~ (text$ (ast-to-text arg)))))) args))))})) (def:' Export-Level @@ -2972,7 +2972,7 @@ (list (' #hidden)))) (def:''' #export (log! message) - (list [["lux" "doc"] (#TextM "Logs message to standard output. + (list [["lux" "doc"] (#TextA "Logs message to standard output. Useful for debugging.")]) (-> Text Unit) @@ -2980,7 +2980,7 @@ [(_lux_proc ["jvm" "getstatic:java.lang.System:out"] []) message])) (macro:' #export (def: tokens) - (list [["lux" "doc"] (#TextM "## Defines global constants/functions. + (list [["lux" "doc"] (#TextA "## Defines global constants/functions. (def: (rejoin-pair pair) (-> [AST AST] (List AST)) (let [[left right] pair] @@ -3070,7 +3070,7 @@ base)) (macro:' #export (macro: tokens) - (list [["lux" "doc"] (#TextM "Macro-definition macro. + (list [["lux" "doc"] (#TextA "Macro-definition macro. (macro: #export (ident-for tokens) (case tokens @@ -3616,7 +3616,7 @@ (#Some tags) (` {#;tags [(~@ (map (: (-> Text AST) (lambda' [tag] - (form$ (list (tag$ ["lux" "TextM"]) + (form$ (list (tag$ ["lux" "TextA"]) (text$ tag))))) tags))] #;type? true}) @@ -3956,7 +3956,7 @@ (lambda [[name [def-type def-meta def-value]]] (case [(get-meta ["lux" "export?"] def-meta) (get-meta ["lux" "hidden?"] def-meta)] - [(#Some (#BoolM true)) #;None] + [(#Some (#BoolA true)) #;None] (list name) _ @@ -4436,7 +4436,7 @@ (lambda [def] (` (;_lux_def (~ (symbol$ ["" def])) (~ (symbol$ [module-name def])) - (#Cons [["lux" "alias"] (#IdentM [(~ (text$ module-name)) (~ (text$ def))])] + (#Cons [["lux" "alias"] (#IdentA [(~ (text$ module-name)) (~ (text$ def))])] #Nil))))) defs') openings (join-map (: (-> Openings (List AST)) @@ -4782,7 +4782,7 @@ ([#BoolS] [#NatS] [#IntS] - [#FracS] + [#DegS] [#RealS] [#CharS] [#TextS] @@ -4903,7 +4903,7 @@ ([#BoolS ->Text] [#NatS Nat->Text] [#IntS ->Text] - [#FracS Frac->Text] + [#DegS Deg->Text] [#RealS ->Text] [#CharS Char/encode] [#TextS Text/encode] @@ -4957,7 +4957,7 @@ (if (< 10 count) (recur (i.inc count) (f x)) x)))"} - (return (list (` (#;TextM (~ (|> tokens + (return (list (` (#;TextA (~ (|> tokens (map (. doc-fragment->Text identify-doc-fragment)) Text/join Text/trim @@ -5102,7 +5102,7 @@ (def: (place-tokens label tokens target) (-> Text (List AST) AST (Maybe (List AST))) (case target - (^or [_ (#BoolS _)] [_ (#NatS _)] [_ (#IntS _)] [_ (#FracS _)] [_ (#RealS _)] [_ (#CharS _)] [_ (#TextS _)] [_ (#TagS _)]) + (^or [_ (#BoolS _)] [_ (#NatS _)] [_ (#IntS _)] [_ (#DegS _)] [_ (#RealS _)] [_ (#CharS _)] [_ (#TextS _)] [_ (#TagS _)]) (#Some (list target)) [_ (#SymbolS [prefix name])] @@ -5193,7 +5193,7 @@ (["Bool"] ["Nat"] ["Int"] - ["Frac"] + ["Deg"] ["Real"] ["Char"] ["Text"]) @@ -5216,7 +5216,7 @@ (["Bool" Bool bool$] ["Nat" Nat nat$] ["Int" Int int$] - ["Frac" Frac frac$] + ["Deg" Deg deg$] ["Real" Real real$] ["Char" Char char$] ["Text" Text text$]) @@ -5577,11 +5577,11 @@ (-> ) (_lux_proc [input]))] - [int-to-nat ["int" "to-nat"] Int Nat] - [nat-to-int ["nat" "to-int"] Nat Int] + [int-to-nat ["int" "to-nat"] Int Nat] + [nat-to-int ["nat" "to-int"] Nat Int] - [real-to-frac ["real" "to-frac"] Real Frac] - [frac-to-real ["frac" "to-real"] Frac Real] + [real-to-deg ["real" "to-deg"] Real Deg] + [deg-to-real ["deg" "to-real"] Deg Real] ) (macro: #export (type-of tokens) -- cgit v1.2.3