diff options
Diffstat (limited to '')
21 files changed, 309 insertions, 302 deletions
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 [<name> <diff>] [(def: #export <name> (-> Int Int) @@ -2097,29 +2097,29 @@ (do-template [<type> <category> <=-name> <=> <lt-name> <lte-name> <lt> <gt-name> <gte-name> <eq-doc> <<-doc> <<=-doc> <>-doc> <>=-doc>] [(def:''' #export (<=-name> test subject) - (list [["lux" "doc"] (#TextM <eq-doc>)]) + (list [["lux" "doc"] (#TextA <eq-doc>)]) (-> <type> <type> Bool) (_lux_proc [<category> <=>] [subject test])) (def:''' #export (<lt-name> test subject) - (list [["lux" "doc"] (#TextM <<-doc>)]) + (list [["lux" "doc"] (#TextA <<-doc>)]) (-> <type> <type> Bool) (_lux_proc [<category> <lt>] [subject test])) (def:''' #export (<lte-name> test subject) - (list [["lux" "doc"] (#TextM <<=-doc>)]) + (list [["lux" "doc"] (#TextA <<=-doc>)]) (-> <type> <type> Bool) (if (_lux_proc [<category> <lt>] [subject test]) true (_lux_proc [<category> <=>] [subject test]))) (def:''' #export (<gt-name> test subject) - (list [["lux" "doc"] (#TextM <>-doc>)]) + (list [["lux" "doc"] (#TextA <>-doc>)]) (-> <type> <type> Bool) (_lux_proc [<category> <lt>] [test subject])) (def:''' #export (<gte-name> test subject) - (list [["lux" "doc"] (#TextM <>=-doc>)]) + (list [["lux" "doc"] (#TextA <>=-doc>)]) (-> <type> <type> Bool) (if (_lux_proc [<category> <lt>] [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 [<type> <name> <op> <doc>] [(def:''' #export (<name> param subject) - (list [["lux" "doc"] (#TextM <doc>)]) + (list [["lux" "doc"] (#TextA <doc>)]) (-> <type> <type> <type>) (_lux_proc <op> [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 [<name> <type> <test> <doc>] [(def:''' #export (<name> left right) - (list [["lux" "doc"] (#TextM <doc>)]) + (list [["lux" "doc"] (#TextA <doc>)]) (-> <type> <type> <type>) (if (<test> 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<Lux> [=xs (mapM Monad<Lux> 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<Lux> @@ -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 @@ (-> <from> <to>) (_lux_proc <op> [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) diff --git a/stdlib/source/lux/compiler.lux b/stdlib/source/lux/compiler.lux index 374556972..367217524 100644 --- a/stdlib/source/lux/compiler.lux +++ b/stdlib/source/lux/compiler.lux @@ -170,14 +170,14 @@ _ #;None))] - [get-bool-ann #;BoolM Bool] - [get-int-ann #;IntM Int] - [get-real-ann #;RealM Real] - [get-char-ann #;CharM Char] - [get-text-ann #;TextM Text] - [get-ident-ann #;IdentM Ident] - [get-list-ann #;ListM (List Ann-Value)] - [get-dict-ann #;DictM (List [Text Ann-Value])] + [get-bool-ann #;BoolA Bool] + [get-int-ann #;IntA Int] + [get-real-ann #;RealA Real] + [get-char-ann #;CharA Char] + [get-text-ann #;TextA Text] + [get-ident-ann #;IdentA Ident] + [get-list-ann #;ListA (List Ann-Value)] + [get-dict-ann #;DictA (List [Text Ann-Value])] ) (def: #export (get-doc anns) @@ -189,7 +189,7 @@ {#;doc "Finds out whether an annotation-as-a-flag is set (has value 'true')."} (-> Ident Anns Bool) (case (get-ann flag-name anns) - (#;Some (#;BoolM true)) + (#;Some (#;BoolA true)) true _ @@ -197,7 +197,7 @@ (do-template [<name> <tag> <desc>] [(def: #export <name> - {#;doc (#;TextM ($_ Text/append "Checks whether a definition is " <desc> "."))} + {#;doc (#;TextA ($_ Text/append "Checks whether a definition is " <desc> "."))} (-> Anns Bool) (flag-set? (ident-for <tag>)))] @@ -220,13 +220,13 @@ _ #;None))] - [try-mlist #;ListM (List Ann-Value)] - [try-mtext #;TextM Text] + [try-mlist #;ListA (List Ann-Value)] + [try-mtext #;TextA Text] ) (do-template [<name> <tag> <desc>] [(def: #export (<name> anns) - {#;doc (#;TextM ($_ Text/append "Looks up the arguments of a " <desc> "."))} + {#;doc (#;TextA ($_ Text/append "Looks up the arguments of a " <desc> "."))} (-> Anns (List Text)) (default (list) (do Monad<Maybe> @@ -248,7 +248,7 @@ (or (export? def-anns) (Text/= module this-module))) (#;Some (:! Macro def-value)) (case (get-ann ["lux" "alias"] def-anns) - (#;Some (#;IdentM [r-module r-name])) + (#;Some (#;IdentA [r-module r-name])) (find-macro' modules this-module r-module r-name) _ @@ -602,7 +602,7 @@ [def-name (normalize def-name) [_ def-anns _] (find-def def-name)] (case (get-ann (ident-for #;alias) def-anns) - (#;Some (#;IdentM real-def-name)) + (#;Some (#;IdentA real-def-name)) (wrap real-def-name) _ diff --git a/stdlib/source/lux/control/ord.lux b/stdlib/source/lux/control/ord.lux index 0200d738a..8bd4ed906 100644 --- a/stdlib/source/lux/control/ord.lux +++ b/stdlib/source/lux/control/ord.lux @@ -18,7 +18,9 @@ (do-template [<name>] [(: (-> a a Bool) <name>)] - [<] [<=] [>] [>=])) + [<] [<=] [>] [>=] + ) + ) ## [Values] (def: #export (ord eq <) @@ -43,4 +45,5 @@ (if (:: ord <op> y x) x y))] [max >] - [min <]) + [min <] + ) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index d9ef60605..66ad6c093 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -190,7 +190,7 @@ (do-template [<name> <tag> <type> <desc>] [(def: #export (<name> key json) - {#;doc (#;TextM (format "A JSON object field getter for " <desc> "."))} + {#;doc (#;TextA (format "A JSON object field getter for " <desc> "."))} (-> Text JSON (Error <type>)) (case (get key json) (#;Right (<tag> value)) @@ -211,7 +211,7 @@ (do-template [<name> <type> <tag> <desc>] [(def: #export (<name> value) - {#;doc (#;TextM (format "A JSON generator for " <desc> "."))} + {#;doc (#;TextA (format "A JSON generator for " <desc> "."))} (Gen <type>) (<tag> value))] @@ -398,7 +398,7 @@ ## Syntax (do-template [<name> <type> <tag> <desc> <pre>] [(def: #export (<name> json) - {#;doc (#;TextM (format "Reads a JSON value as " <desc> "."))} + {#;doc (#;TextA (format "Reads a JSON value as " <desc> "."))} (Parser <type>) (case json (<tag> value) @@ -416,7 +416,7 @@ (do-template [<test> <check> <type> <eq> <codec> <tag> <desc> <pre>] [(def: #export (<test> test json) - {#;doc (#;TextM (format "Asks whether a JSON value is a " <desc> "."))} + {#;doc (#;TextA (format "Asks whether a JSON value is a " <desc> "."))} (-> <type> (Parser Bool)) (case json (<tag> value) @@ -426,7 +426,7 @@ (#;Left (format "JSON value is not a " <desc> ": " (show-json json))))) (def: #export (<check> test json) - {#;doc (#;TextM (format "Ensures a JSON value is a " <desc> "."))} + {#;doc (#;TextA (format "Ensures a JSON value is a " <desc> "."))} (-> <type> (Parser Unit)) (case json (<tag> value) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index c5b3277f8..695f9c7b9 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -22,7 +22,7 @@ [ Nat n.=] [ Int i.=] - [Frac f.=] + [Deg d.=] [Real r.=] ) @@ -36,7 +36,7 @@ [ Nat Eq<Nat> n.< n.<= n.> n.>=] [ Int Eq<Int> i.< i.<= i.> i.>=] - [Frac Eq<Frac> f.< f.<= f.> f.>=] + [Deg Eq<Deg> d.< d.<= d.> d.>=] [Real Eq<Real> r.< r.<= r.> r.>=] ) @@ -79,17 +79,17 @@ [Real Ord<Real> r.+ r.- r.* r./ r.% r.= r.< 0.0 1.0 -1.0] ) -(struct: #export _ (Number Frac) - (def: ord Ord<Frac>) - (def: + f.+) - (def: - f.-) - (def: * f.*) - (def: / f./) - (def: % f.%) - (def: (negate x) (f.- x (_lux_proc ["frac" "max-value"] []))) +(struct: #export _ (Number Deg) + (def: ord Ord<Deg>) + (def: + d.+) + (def: - d.-) + (def: * d.*) + (def: / d./) + (def: % d.%) + (def: (negate x) (d.- x (_lux_proc ["deg" "max-value"] []))) (def: abs id) (def: (signum x) - (_lux_proc ["frac" "max-value"] [])) + (_lux_proc ["deg" "max-value"] [])) ) (do-template [<type> <ord> <succ> <pred>] @@ -110,7 +110,7 @@ [ Nat (_lux_proc ["nat" "max-value"] []) (_lux_proc ["nat" "min-value"] [])] [ Int (_lux_proc ["jvm" "getstatic:java.lang.Long:MAX_VALUE"] []) (_lux_proc ["jvm" "getstatic:java.lang.Long:MIN_VALUE"] [])] [Real (_lux_proc ["jvm" "getstatic:java.lang.Double:MAX_VALUE"] []) (_lux_proc ["jvm" "getstatic:java.lang.Double:MIN_VALUE"] [])] - [Frac (_lux_proc ["frac" "max-value"] []) (_lux_proc ["frac" "min-value"] [])]) + [Deg (_lux_proc ["deg" "max-value"] []) (_lux_proc ["deg" "min-value"] [])]) (do-template [<name> <type> <unit> <append>] [(struct: #export <name> (Monoid <type>) @@ -129,10 +129,10 @@ [Mul@Monoid<Real> Real 1.0 r.*] [Max@Monoid<Real> Real (:: Bounded<Real> bottom) r.max] [Min@Monoid<Real> Real (:: Bounded<Real> top) r.min] - [Add@Monoid<Frac> Frac (:: Bounded<Frac> bottom) f.+] - [Mul@Monoid<Frac> Frac (:: Bounded<Frac> top) f.*] - [Max@Monoid<Frac> Frac (:: Bounded<Frac> bottom) f.max] - [Min@Monoid<Frac> Frac (:: Bounded<Frac> top) f.min] + [Add@Monoid<Deg> Deg (:: Bounded<Deg> bottom) d.+] + [Mul@Monoid<Deg> Deg (:: Bounded<Deg> top) d.*] + [Max@Monoid<Deg> Deg (:: Bounded<Deg> bottom) d.max] + [Min@Monoid<Deg> Deg (:: Bounded<Deg> top) d.min] ) (def: (text.replace pattern value template) @@ -153,7 +153,7 @@ (#;Left <error>))))] [Nat ["nat" "encode"] ["nat" "decode"] "Couldn't decode Nat"] - [Frac ["frac" "encode"] ["frac" "decode"] "Couldn't decode Frac"] + [Deg ["deg" "encode"] ["deg" "decode"] "Couldn't decode Deg"] ) (def: clean-number diff --git a/stdlib/source/lux/data/struct/set.lux b/stdlib/source/lux/data/struct/set.lux index 5f828ba43..711ae4553 100644 --- a/stdlib/source/lux/data/struct/set.lux +++ b/stdlib/source/lux/data/struct/set.lux @@ -47,9 +47,9 @@ (All [a] (-> (Set a) (Set a) (Set a))) (dict;merge xs yx)) -(def: #export (difference subs base) +(def: #export (difference sub base) (All [a] (-> (Set a) (Set a) (Set a))) - (List/fold remove base (to-list subs))) + (List/fold remove base (to-list sub))) (def: #export (intersection filter base) (All [a] (-> (Set a) (Set a) (Set a))) diff --git a/stdlib/source/lux/data/struct/tree.lux b/stdlib/source/lux/data/struct/tree/rose.lux index 8620e46a7..8620e46a7 100644 --- a/stdlib/source/lux/data/struct/tree.lux +++ b/stdlib/source/lux/data/struct/tree/rose.lux diff --git a/stdlib/source/lux/data/struct/zipper.lux b/stdlib/source/lux/data/struct/tree/zipper.lux index 2a447a65b..74dbd024f 100644 --- a/stdlib/source/lux/data/struct/zipper.lux +++ b/stdlib/source/lux/data/struct/tree/zipper.lux @@ -6,7 +6,7 @@ (;module: lux (lux (data (struct [list "" Monad<List> Fold<List> "List/" Monoid<List>] - [tree #+ Tree] + (tree [rose #+ Tree]) [stack #+ Stack])) [compiler] (macro [ast] @@ -36,11 +36,11 @@ (def: #export (value zipper) (All [a] (-> (Zipper a) a)) - (|> zipper (get@ #node) (get@ #tree;value))) + (|> zipper (get@ #node) (get@ #rose;value))) (def: #export (children zipper) (All [a] (-> (Zipper a) (List (Tree a)))) - (|> zipper (get@ #node) (get@ #tree;children))) + (|> zipper (get@ #node) (get@ #rose;children))) (def: #export (branch? zipper) (All [a] (-> (Zipper a) Bool)) @@ -76,7 +76,7 @@ (|> parent (update@ #node (: (-> (Tree ($ +0)) (Tree ($ +0))) (lambda [node] - (set@ #tree;children (List/append (list;reverse (get@ #lefts zipper)) + (set@ #rose;children (List/append (list;reverse (get@ #lefts zipper)) (#;Cons (get@ #node zipper) (get@ #rights zipper))) node))))))) @@ -112,26 +112,26 @@ (def: #export (set value zipper) (All [a] (-> a (Zipper a) (Zipper a))) - (set@ [#node #tree;value] value zipper)) + (set@ [#node #rose;value] value zipper)) (def: #export (update f zipper) (All [a] (-> (-> a a) (Zipper a) (Zipper a))) - (update@ [#node #tree;value] f zipper)) + (update@ [#node #rose;value] f zipper)) (def: #export (prepend-child value zipper) (All [a] (-> a (Zipper a) (Zipper a))) - (update@ [#node #tree;children] + (update@ [#node #rose;children] (lambda [children] - (#;Cons (tree;tree ($ +0) {value []}) + (#;Cons (rose;tree ($ +0) {value []}) children)) zipper)) (def: #export (append-child value zipper) (All [a] (-> a (Zipper a) (Zipper a))) - (update@ [#node #tree;children] + (update@ [#node #rose;children] (lambda [children] (List/append children - (list (tree;tree ($ +0) {value []})))) + (list (rose;tree ($ +0) {value []})))) zipper)) (def: #export (remove zipper) @@ -144,7 +144,7 @@ (#;Some next) (#;Some (|> next - (update@ [#node #tree;children] (|>. list;tail (default (list))))))) + (update@ [#node #rose;children] (|>. list;tail (default (list))))))) (#;Cons next side) (#;Some (|> zipper @@ -161,7 +161,7 @@ _ (#;Some (|> zipper (update@ <side> (lambda [side] - (#;Cons (tree;tree ($ +0) {value []}) + (#;Cons (rose;tree ($ +0) {value []}) side)))))))] [insert-left #lefts] diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index ebcb3fc48..2ae5c62ca 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -40,7 +40,7 @@ [%b Bool (:: bool;Codec<Text,Bool> encode)] [%n Nat (:: number;Codec<Text,Nat> encode)] [%i Int (:: number;Codec<Text,Int> encode)] - [%f Frac (:: number;Codec<Text,Frac> encode)] + [%f 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)] diff --git a/stdlib/source/lux/lexer.lux b/stdlib/source/lux/lexer.lux index 787cbb0c5..ca8f7f5cf 100644 --- a/stdlib/source/lux/lexer.lux +++ b/stdlib/source/lux/lexer.lux @@ -317,7 +317,7 @@ (do-template [<name> <bottom> <top> <desc>] [(def: #export <name> - {#;doc (#;TextM ($_ Text/append "Only lex " <desc> " characters."))} + {#;doc (#;TextA ($_ Text/append "Only lex " <desc> " characters."))} (Lexer Char) (char-range <bottom> <top>))] diff --git a/stdlib/source/lux/regex.lux b/stdlib/source/lux/lexer/regex.lux index 5684a4465..5684a4465 100644 --- a/stdlib/source/lux/regex.lux +++ b/stdlib/source/lux/lexer/regex.lux diff --git a/stdlib/source/lux/macro/ast.lux b/stdlib/source/lux/macro/ast.lux index 8976ca64d..821264c09 100644 --- a/stdlib/source/lux/macro/ast.lux +++ b/stdlib/source/lux/macro/ast.lux @@ -43,7 +43,7 @@ [bool Bool #;BoolS] [nat Nat #;NatS] [int Int #;IntS] - [frac Frac #;FracS] + [deg Deg #;DegS] [real Real #;RealS] [char Char #;CharS] [text Text #;TextS] @@ -73,7 +73,7 @@ ([#;BoolS Eq<Bool>] [#;NatS Eq<Nat>] [#;IntS Eq<Int>] - [#;FracS Eq<Frac>] + [#;DegS Eq<Deg>] [#;RealS Eq<Real>] [#;CharS char;Eq<Char>] [#;TextS Eq<Text>] @@ -110,7 +110,7 @@ ([#;BoolS Codec<Text,Bool>] [#;NatS Codec<Text,Nat>] [#;IntS Codec<Text,Int>] - [#;FracS Codec<Text,Frac>] + [#;DegS Codec<Text,Deg>] [#;RealS Codec<Text,Real>] [#;CharS char;Codec<Text,Char>] [#;TextS text;Codec<Text,Text>] diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index ec4a87068..d194a540b 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -59,7 +59,7 @@ [bool "Bool"] [nat "Nat"] [int "Int"] - [frac "Frac"] + [deg "Deg"] [real "Real"] [char "Char"] [text "Text"] @@ -78,7 +78,7 @@ [bool Bool] [nat Nat] [int Int] - [frac Frac] + [deg Deg] [real Real] [char Char] [text Text])] diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux index dc37e0c9f..bdce71d50 100644 --- a/stdlib/source/lux/macro/poly/eq.lux +++ b/stdlib/source/lux/macro/poly/eq.lux @@ -50,7 +50,7 @@ [Bool poly;bool bool;Eq<Bool>] [Nat poly;nat number;Eq<Nat>] [Int poly;int number;Eq<Int>] - [Frac poly;frac number;Eq<Frac>] + [Deg poly;deg number;Eq<Deg>] [Real poly;real number;Eq<Real>] [Char poly;char char;Eq<Char>] [Text poly;text text;Eq<Text>])] diff --git a/stdlib/source/lux/macro/poly/text-encoder.lux b/stdlib/source/lux/macro/poly/text-encoder.lux index 858abc208..c538844a7 100644 --- a/stdlib/source/lux/macro/poly/text-encoder.lux +++ b/stdlib/source/lux/macro/poly/text-encoder.lux @@ -51,7 +51,7 @@ [Bool poly;bool (:: bool;Codec<Text,Bool> encode)] [Nat poly;nat (:: number;Codec<Text,Nat> encode)] [Int poly;int (:: number;Codec<Text,Int> encode)] - [Frac poly;frac (:: number;Codec<Text,Frac> encode)] + [Deg poly;deg (:: number;Codec<Text,Deg> encode)] [Real poly;real (:: number;Codec<Text,Real> encode)] [Char poly;char (:: char;Codec<Text,Char> encode)] [Text poly;text (:: text;Codec<Text,Text> encode)])] diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 45aaee1bb..ba24b607b 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -92,7 +92,7 @@ (do-template [<get-name> <type> <tag> <eq> <desc>] [(def: #export <get-name> - {#;doc (#;TextM ($_ Text/append "Parses the next " <desc> " input AST."))} + {#;doc (#;TextA ($_ Text/append "Parses the next " <desc> " input AST."))} (Syntax <type>) (lambda [tokens] (case tokens @@ -105,7 +105,7 @@ [ bool Bool #;BoolS bool;Eq<Bool> "bool"] [ nat Nat #;NatS number;Eq<Nat> "nat"] [ int Int #;IntS number;Eq<Int> "int"] - [ frac Frac #;FracS number;Eq<Frac> "frac"] + [ deg Deg #;DegS number;Eq<Deg> "deg"] [ real Real #;RealS number;Eq<Real> "real"] [ char Char #;CharS char;Eq<Char> "char"] [ text Text #;TextS text;Eq<Text> "text"] @@ -164,7 +164,7 @@ (do-template [<name> <tag> <desc>] [(def: #export <name> - {#;doc (#;TextM ($_ Text/append "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))} + {#;doc (#;TextA ($_ Text/append "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))} (Syntax Text) (lambda [tokens] (case tokens @@ -180,7 +180,7 @@ (do-template [<name> <tag> <desc>] [(def: #export (<name> p) - {#;doc (#;TextM ($_ 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 ASTs."))} (All [a] (-> (Syntax a) (Syntax a))) (lambda [tokens] @@ -198,7 +198,7 @@ ) (def: #export (record p) - {#;doc (#;TextM ($_ 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 ASTs."))} (All [a] (-> (Syntax a) (Syntax a))) (lambda [tokens] diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux index 72faa2ada..96203b4c2 100644 --- a/stdlib/source/lux/macro/syntax/common.lux +++ b/stdlib/source/lux/macro/syntax/common.lux @@ -105,13 +105,13 @@ (def: list-meta^ (Syntax (List AST)) (s;form (do s;Monad<Syntax> - [_ (s;sample! (' #lux;ListM))] + [_ (s;sample! (' #lux;ListA))] (flat-list^ [])))) (def: text-meta^ (Syntax Text) (s;form (do s;Monad<Syntax> - [_ (s;sample! (' #lux;TextM))] + [_ (s;sample! (' #lux;TextA))] s;text))) (def: (find-def-args meta-data) diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index c1d855c8e..d5a03b421 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -57,6 +57,10 @@ [radians "invokestatic:java.lang.Math:toRadians:double"] ) +(def: #export (square n) + (-> Real Real) + (r.* n n)) + (do-template [<name> <method>] [(def: #export (<name> n) (-> Real Real) @@ -110,7 +114,7 @@ (s/map ast;bool s;bool) (s/map ast;nat s;nat) (s/map ast;int s;int) - (s/map ast;frac s;frac) + (s/map ast;deg s;deg) (s/map ast;real s;real) (s/map ast;char s;char) (s/map ast;text s;text) diff --git a/stdlib/source/lux/math/simple.lux b/stdlib/source/lux/math/simple.lux index 111e5cc8c..f8b059794 100644 --- a/stdlib/source/lux/math/simple.lux +++ b/stdlib/source/lux/math/simple.lux @@ -46,7 +46,7 @@ _ (wrap raw-type)))) -(do-template [<name> <rec> <nat-op> <int-op> <real-op> <frac-op>] +(do-template [<name> <rec> <nat-op> <int-op> <real-op> <deg-op>] [(syntax: #export (<name> [args ($_ s;alt (s;seq (s;alt s;symbol s;any) (s;some s;any)) @@ -58,7 +58,7 @@ ## (= (<name> 1.0 2.0) ## (<real-op> 1.0 2.0)) ## (= (<name> .1 .2) - ## (<frac-op> .1 .2)))} + ## (<deg-op> .1 .2)))} (case args (+0 [(#;Left x) ys]) (do @ @@ -72,8 +72,8 @@ (check;checks? Real =x) (wrap (` <real-op>)) - (check;checks? Frac =x) - (wrap (` <frac-op>)) + (check;checks? Deg =x) + (wrap (` <deg-op>)) (compiler;fail (format "No operation for types: " (%type =x))))] (wrap (list (` ($_ (~ op) (~ (ast;symbol x)) (~@ ys)))))) @@ -96,21 +96,21 @@ (check;checks? (-> Real Real Real) =e) (wrap (` <real-op>)) - (check;checks? (-> Frac Frac Frac) =e) - (wrap (` <frac-op>)) + (check;checks? (-> Deg Deg Deg) =e) + (wrap (` <deg-op>)) (compiler;fail (format "No operation for type: " (%type =e))))] (wrap (list op))) ))] - [+ ;;+ n.+ i.+ r.+ f.+] - [- ;;- n.- i.- r.- f.-] - [* ;;* n.* i.* r.* f.*] - [/ ;;/ n./ i./ r./ f./] - [% ;;% n.% i.% r.% f.%] + [+ ;;+ n.+ i.+ r.+ d.+] + [- ;;- n.- i.- r.- d.-] + [* ;;* n.* i.* r.* d.*] + [/ ;;/ n./ i./ r./ d./] + [% ;;% n.% i.% r.% d.%] ) -(do-template [<name> <rec> <nat-op> <int-op> <real-op> <frac-op>] +(do-template [<name> <rec> <nat-op> <int-op> <real-op> <deg-op>] [(syntax: #export (<name> [args ($_ s;alt (s;seq (s;alt s;symbol s;any) (s;some s;any)) @@ -122,7 +122,7 @@ ## (= (<name> 1.0 2.0) ## (<real-op> 1.0 2.0)) ## (= (<name> .1 .2) - ## (<frac-op> .1 .2)))} + ## (<deg-op> .1 .2)))} (case args (+0 [(#;Left x) ys]) (do @ @@ -136,8 +136,8 @@ (check;checks? Real =x) (wrap (` <real-op>)) - (check;checks? Frac =x) - (wrap (` <frac-op>)) + (check;checks? Deg =x) + (wrap (` <deg-op>)) (compiler;fail (format "No operation for types: " (%type =x))))] (wrap (list (` ($_ (~ op) (~ (ast;symbol x)) (~@ ys)))))) @@ -160,18 +160,18 @@ (check;checks? (-> Real Real Bool) =e) (wrap (` <real-op>)) - (check;checks? (-> Frac Frac Bool) =e) - (wrap (` <frac-op>)) + (check;checks? (-> Deg Deg Bool) =e) + (wrap (` <deg-op>)) (compiler;fail (format "No operation for type: " (%type =e))))] (wrap (list op))) ))] - [= ;;= n.= i.= r.= f.=] - [< ;;< n.< i.< r.< f.<] - [<= ;;<= n.<= i.<= r.<= f.<=] - [> ;;> n.> i.> r.> f.>] - [>= ;;>= n.>= i.>= r.>= f.>=] + [= ;;= n.= i.= r.= d.=] + [< ;;< n.< i.< r.< d.<] + [<= ;;<= n.<= i.<= r.<= d.<=] + [> ;;> n.> i.> r.> d.>] + [>= ;;>= n.>= i.>= r.>= d.>=] ) (do-template [<name> <rec> <nat-op> <int-op>] diff --git a/stdlib/source/lux/random.lux b/stdlib/source/lux/random.lux index 802dbfae6..195255643 100644 --- a/stdlib/source/lux/random.lux +++ b/stdlib/source/lux/random.lux @@ -100,9 +100,9 @@ int-to-real (r./ (|> +1 (bit;<< +53) nat-to-int int-to-real)))))) -(def: #export frac - (Random Frac) - (:: Monad<Random> map real-to-frac real)) +(def: #export deg + (Random Deg) + (:: Monad<Random> map real-to-deg real)) (def: #export char (Random Char) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index e7012f06e..9524a2168 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -247,7 +247,7 @@ body)] (with-gensyms [g!test] (wrap (list (` (def: #export (~ g!test) - {#;;test (#;TextM (~ description))} + {#;;test (#;TextA (~ description))} (IO Test) (io (~ body))))))))) |