diff options
| author | Eduardo Julian | 2017-12-02 12:49:25 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2017-12-02 12:49:25 -0400 |
| commit | 1651d847ba70ee36171f3809a25bece325fd5715 (patch) | |
| tree | 9cf19984d86d9adb336859b396ba3199c8d28890 | |
| parent | 46955edbe6cea9f367562b9fb17cef526109d9e0 (diff) | |
- Added context-sensitive macro-expansion by means of "lux in-module", and removed all the (now unnecessary) #hidden tags.
- Fixed a bug when loading the imports from the cache.
- Added special notation for context-sensitive macro-expansion.
33 files changed, 277 insertions, 366 deletions
diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el index 2f0f9db19..b82fed540 100644 --- a/lux-mode/lux-mode.el +++ b/lux-mode/lux-mode.el @@ -229,7 +229,7 @@ Called by `imenu--generic-function'." "char" "exec" "let" "if" "cond" "do" "be" "open" "loop" "recur" "comment" "for" "list" "list&" "io" "sequence" "tree" - "get@" "set@" "update@" "|>" "|>>" "<|" "<<|" "_$" "$_" "~" "~+" "~@" "~'" "::" ":::" + "get@" "set@" "update@" "|>" "|>>" "<|" "<<|" "_$" "$_" "~" "~+" "~@" "~!" "~'" "::" ":::" "|" "&" "->" "All" "Ex" "Rec" "primitive" "$" "type" "^" "^or" "^slots" "^multi" "^~" "^@" "^template" "^open" "^|>" "^code" "^stream&" "^regex" "bin" "oct" "hex" diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj index 6e765cb9b..1202d4faf 100644 --- a/luxc/src/lux/analyser.clj +++ b/luxc/src/lux/analyser.clj @@ -163,8 +163,7 @@ (&&lux/analyse-module analyse optimize eval! compile-module ?meta))) "lux in-module" - (|let [(&/$Cons [_ (&/$Text ?module)] - (&/$Cons ?expr (&/$Nil))) parameters] + (|let [(&/$Cons [_ (&/$Text ?module)] (&/$Cons ?expr (&/$Nil))) parameters] (&/with-cursor cursor (&/with-module ?module (analyse exo-type ?expr)))) diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj index b9ea64839..07cf17d2f 100644 --- a/luxc/src/lux/analyser/lux.clj +++ b/luxc/src/lux/analyser/lux.clj @@ -365,7 +365,7 @@ (defn analyse-apply [analyse cursor exo-type macro-caller =fn ?args] (|case =fn [_ (&&/$def ?module ?name)] - (|do [[real-name [?type ?meta ?value]] (&&module/find-def ?module ?name)] + (|do [[real-name [?type ?meta ?value]] (&&module/find-def! ?module ?name)] (|case (&&meta/meta-get &&meta/macro?-tag ?meta) (&/$Some _) (|do [macro-expansion (fn [state] @@ -377,7 +377,7 @@ ((&/fail-with-loc error) state))) ;; module-name &/get-module-name ;; :let [[r-prefix r-name] real-name - ;; _ (when (= "refer" r-name) + ;; _ (when (= "syntax:" r-name) ;; (->> (&/|map &/show-ast macro-expansion) ;; (&/|interpose "\n") ;; (&/fold str "") diff --git a/luxc/src/lux/analyser/module.clj b/luxc/src/lux/analyser/module.clj index ef89777a4..8468249ab 100644 --- a/luxc/src/lux/analyser/module.clj +++ b/luxc/src/lux/analyser/module.clj @@ -226,6 +226,29 @@ ms)))) nil))) +(defn find-def! [module name] + (|do [current-module &/get-module-name] + (fn [state] + (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] + (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] + (|let [[?type ?meta ?value] $def] + (if (.equals ^Object current-module module) + (|case (&meta/meta-get &meta/alias-tag ?meta) + (&/$Some [_ (&/$Symbol [?r-module ?r-name])]) + ((find-def! ?r-module ?r-name) + state) + + _ + (return* state (&/T [(&/T [module name]) $def]))) + (return* state (&/T [(&/T [module name]) $def])))) + ((&/fail-with-loc (str "[Analyser Error @ find-def!] Definition does not exist: " (str module &/+name-separator+ name) + " at module: " current-module)) + state)) + ((&/fail-with-loc (str "[Analyser Error @ find-def!] Module does not exist: " module + " at module: " current-module)) + state)) + ))) + (defn find-def [module name] (|do [current-module &/get-module-name] (fn [state] @@ -248,13 +271,17 @@ (return* state (&/T [(&/T [module name]) $def])) _ - ((&/fail-with-loc (str "[Analyser Error @ find-def] Cannot use unexported definition: " (str module &/+name-separator+ name))) + ((&/fail-with-loc (str "[Analyser Error @ find-def] Cannot use unexported definition: " (str module &/+name-separator+ name) + " at module: " current-module)) state)))) - ((&/fail-with-loc (str "[Analyser Error @ find-def] Definition does not exist: " (str module &/+name-separator+ name))) + ((&/fail-with-loc (str "[Analyser Error @ find-def] Definition does not exist: " (str module &/+name-separator+ name) + " at module: " current-module)) state)) - ((&/fail-with-loc (str "[Analyser Error @ find-def] Module does not exist: " module)) + ((&/fail-with-loc (str "[Analyser Error @ find-def] Module does not exist: " module + " at module: " current-module)) state)) - ((&/fail-with-loc (str "[Analyser Error @ find-def] Unknown module: " module)) + ((&/fail-with-loc (str "[Analyser Error @ find-def] Unknown module: " module + " at module: " current-module)) state)) ))) @@ -270,7 +297,7 @@ (&/fail-with-loc (str "[Analyser Error] Not a type definition: " (&/adt->text def-data)))))) (defn defined? [module name] - (&/try-all% (&/|list (|do [_ (find-def module name)] + (&/try-all% (&/|list (|do [_ (find-def! module name)] (return true)) (return false)))) diff --git a/luxc/src/lux/compiler/cache.clj b/luxc/src/lux/compiler/cache.clj index 28cfe53ee..4ec18798e 100644 --- a/luxc/src/lux/compiler/cache.clj +++ b/luxc/src/lux/compiler/cache.clj @@ -135,18 +135,15 @@ imports (if (= [""] imports) &/$Nil (&/->list imports))] - (&/|map #(.split ^String % &&core/datum-separator 2) imports))] - cache-table* (&/fold% (fn [cache-table* _import] - (|do [:let [[_module _hash] _import] - [file-name file-content] (&&io/read-file source-dirs _module) + (&/|map #(first (vec (.split ^String % &&core/datum-separator 2))) imports))] + cache-table* (&/fold% (fn [cache-table* _module] + (|do [[file-name file-content] (&&io/read-file source-dirs _module) output (pre-load! source-dirs cache-table* _module (hash file-content) load-def-value install-all-defs-in-module uninstall-all-defs-in-module)] (return output))) cache-table imports)] - (if (&/|every? (fn [_import] - (|let [[_module _hash] _import] - (contains? cache-table* _module))) + (if (&/|every? (fn [_module] (contains? cache-table* _module)) imports) (let [tag-groups (parse-tag-groups _tags-section) [?module-anns _] (if (= "..." _module-anns-section) diff --git a/luxc/src/lux/compiler/jvm/lux.clj b/luxc/src/lux/compiler/jvm/lux.clj index 024abeb73..d98c7537b 100644 --- a/luxc/src/lux/compiler/jvm/lux.clj +++ b/luxc/src/lux/compiler/jvm/lux.clj @@ -117,7 +117,7 @@ (defn compile-apply [compile ?fn ?args] (|case ?fn [_ (&o/$def ?module ?name)] - (|do [[_ [_ _ func-obj]] (&a-module/find-def ?module ?name) + (|do [[_ [_ _ func-obj]] (&a-module/find-def! ?module ?name) class-loader &/loader :let [func-class (class func-obj) func-arity (.get ^Field (.getDeclaredField func-class &&/arity-field) nil) diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 22fc75e92..e7dae30b1 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -898,11 +898,6 @@ (flag-meta "export?")) (record$ #Nil)) -("lux def" hidden?-meta - ("lux check" Code - (flag-meta "hidden?")) - (record$ #Nil)) - ("lux def" macro?-meta ("lux check" Code (flag-meta "macro?")) @@ -916,14 +911,6 @@ (#Cons tail #Nil)))))) (record$ #Nil)) -("lux def" with-hidden-meta - ("lux check" (#Function Code Code) - (function'' [tail] - (form$ (#Cons (tag$ ["lux" "Cons"]) - (#Cons hidden?-meta - (#Cons tail #Nil)))))) - (record$ #Nil)) - ("lux def" with-macro-meta ("lux check" (#Function Code Code) (function'' [tail] @@ -1549,9 +1536,7 @@ ys})) (def:''' #export (splice-helper xs ys) - (#Cons [(tag$ ["lux" "hidden?"]) - (bool$ true)] - #Nil) + #Nil (-> ($' List Code) ($' List Code) ($' List Code)) ("lux case" xs {(#Cons x xs') @@ -1842,9 +1827,9 @@ #None (#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident)))}))) -(def:''' (splice replace? untemplate subst elems) +(def:''' (splice replace? untemplate elems) #Nil - (-> Bool (-> Code ($' Meta Code)) Text ($' List Code) ($' Meta Code)) + (-> Bool (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code)) ("lux case" replace? {true ("lux case" (list/reverse elems) @@ -1855,9 +1840,8 @@ (do Monad<Meta> [lastO ("lux case" lastI {[_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))] - (wrap (if (text/= "" subst) - spliced - (form$ (list (text$ "lux in-module") (text$ subst) spliced)))) + (let' [[[_module-name _ _] _] spliced] + (wrap spliced)) _ (do Monad<Meta> @@ -1867,11 +1851,10 @@ (function' [leftI rightO] ("lux case" leftI {[_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))] - (wrap (form$ (list (symbol$ ["lux" "splice-helper"]) - (if (text/= "" subst) - spliced - (form$ (list (text$ "lux in-module") (text$ subst) spliced))) - rightO))) + (let' [[[_module-name _ _] _] spliced] + (wrap (form$ (list (symbol$ ["lux" "splice-helper"]) + spliced + rightO)))) _ (do Monad<Meta> @@ -1884,6 +1867,11 @@ [=elems (monad/map Monad<Meta> untemplate elems)] (wrap (untemplate-list =elems)))})) +(def:''' (untemplate-text value) + #Nil + (-> Text Code) + (wrap-meta (form$ (list (tag$ ["lux" "Text"]) (text$ value))))) + (def:''' (untemplate replace? subst token) #Nil (-> Bool Text Code ($' Meta Code)) @@ -1935,9 +1923,15 @@ (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) [true [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]] - (return (if (text/= "" subst) - unquoted - (form$ (list (text$ "lux in-module") (text$ subst) unquoted)))) + (return unquoted) + + [true [_ (#Form (#Cons [[_ (#Symbol ["" "~!"])] (#Cons [dependent #Nil])]))]] + (do Monad<Meta> + [independent (untemplate replace? subst dependent)] + (wrap (wrap-meta (form$ (list (tag$ ["lux" "Form"]) + (untemplate-list (list (untemplate-text "lux in-module") + (untemplate-text subst) + independent))))))) [true [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [ident #Nil])]))]] (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) ident)))) @@ -1947,13 +1941,13 @@ [_ [meta (#Form elems)]] (do Monad<Meta> - [output (splice replace? (untemplate replace? subst) subst elems) + [output (splice replace? (untemplate replace? subst) elems) #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Form"]) output)))]] (wrap [meta output'])) [_ [meta (#Tuple elems)]] (do Monad<Meta> - [output (splice replace? (untemplate replace? subst) subst elems) + [output (splice replace? (untemplate replace? subst) elems) #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Tuple"]) output)))]] (wrap [meta output'])) @@ -2015,7 +2009,9 @@ (do Monad<Meta> [current-module current-module-name =template (untemplate true current-module template)] - (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) + (wrap (list (form$ (list (text$ "lux check") + (symbol$ ["lux" "Code"]) + =template))))) _ (fail "Wrong syntax for `")})) @@ -3128,36 +3124,20 @@ (` {#.type-args [(~+ (list/map (function [arg] (text$ (code-to-text arg))) args))]})) -(def:' Export-Level - Type - ($' Either - Unit ## Exported - Unit ## Hidden - )) - -(def:' (export-level^ tokens) - (-> (List Code) [(Maybe Export-Level) (List Code)]) +(def:' (export^ tokens) + (-> (List Code) [Bool (List Code)]) (case tokens (#Cons [_ (#Tag [_ "export"])] tokens') - [(#Some (#Left [])) tokens'] - - (#Cons [_ (#Tag [_ "hidden"])] tokens') - [(#Some (#Right [])) tokens'] + [true tokens'] _ - [#None tokens])) + [false tokens])) -(def:' (export-level ?el) - (-> (Maybe Export-Level) (List Code)) - (case ?el - #None - (list) - - (#Some (#Left [])) +(def:' (export ?) + (-> Bool (List Code)) + (if ? (list (' #export)) - - (#Some (#Right [])) - (list (' #hidden)))) + (list))) (macro:' #export (def: tokens) (list [(tag$ ["lux" "doc"]) @@ -3170,7 +3150,7 @@ (def: branching-exponent Int 5)")]) - (let [[export? tokens'] (export-level^ tokens) + (let [[export? tokens'] (export^ tokens) parts (: (Maybe [Code (List Code) (Maybe Code) Code (List [Code Code])]) (case tokens' (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] type body)) @@ -3218,18 +3198,9 @@ (~ body) [(~ cursor-code) (#Record (~ (with-func-args args - (case export? - #None - =meta - - (#Some (#Left [])) + (if export? (with-export-meta =meta) - - (#Some (#Right [])) - (|> =meta - with-export-meta - with-hidden-meta) - ))))]))))) + =meta))))]))))) #None (fail "Wrong syntax for def:")))) @@ -3265,7 +3236,7 @@ _ (fail \"Wrong syntax for ident-for\")))")]) - (let [[exported? tokens] (export-level^ tokens) + (let [[exported? tokens] (export^ tokens) name+args+meta+body?? (: (Maybe [Ident (List Code) Code Code]) (case tokens (^ (list [_ (#Form (list& [_ (#Symbol name)] args))] body)) @@ -3288,7 +3259,7 @@ def-sig (case args #Nil name _ (` ((~ name) (~+ args))))] - (return (list (` (..def: (~+ (export-level exported?)) + (return (list (` (..def: (~+ (export exported?)) (~ def-sig) (~ (meta-code-merge (` {#.macro? true}) meta)) @@ -3313,7 +3284,7 @@ >) (: (-> a a Bool) >=))"} - (let [[exported? tokens'] (export-level^ tokens) + (let [[exported? tokens'] (export^ tokens) ?parts (: (Maybe [Ident (List Code) Code (List Code)]) (case tokens' (^ (list& [_ (#Form (list& [_ (#Symbol name)] args))] [meta-rec-cursor (#Record meta-rec-parts)] sigs)) @@ -3360,7 +3331,7 @@ _ (` ((~ def-name) (~+ args))))]] - (return (list (` (..type: (~+ (export-level exported?)) (~ usage) (~ sig-meta) (~ sig-type)))))) + (return (list (` (..type: (~+ (export exported?)) (~ usage) (~ sig-meta) (~ sig-type)))))) #None (fail "Wrong syntax for sig:")))) @@ -3723,7 +3694,7 @@ (def: (lux.>= test subject) (or (lux.> test subject) (lux.= test subject))))"} - (let [[exported? tokens'] (export-level^ tokens) + (let [[exported? tokens'] (export^ tokens) ?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)) @@ -3775,7 +3746,7 @@ _ (` ((~ name) (~+ args))))] - (return (list (` (..def: (~+ (export-level exported?)) (~ usage) + (return (list (` (..def: (~+ (export exported?)) (~ usage) (~ (meta-code-merge (` {#.struct? true}) meta)) (~ type) @@ -3799,7 +3770,7 @@ (type: (List a) #Nil (#Cons a (List a)))"} - (let [[exported? tokens'] (export-level^ tokens) + (let [[exported? tokens'] (export^ tokens) [rec? tokens'] (case tokens' (#Cons [_ (#Tag [_ "rec"])] tokens') [true tokens'] @@ -3860,7 +3831,7 @@ (#Some (` (All (~ type-name) [(~+ args)] (~ type)))))))] (case type' (#Some type'') - (return (list (` (..def: (~+ (export-level exported?)) (~ type-name) + (return (list (` (..def: (~+ (export exported?)) (~ type-name) (~ ($_ meta-code-merge (with-type-args args) (if rec? (' {#.type-rec? true}) (' {})) type-meta @@ -4198,9 +4169,8 @@ (let [to-alias (list/map (: (-> [Text Def] (List Text)) (function [[name [def-type def-meta def-value]]] - (case [(get-meta ["lux" "export?"] def-meta) - (get-meta ["lux" "hidden?"] def-meta)] - [(#Some [_ (#Bool true)]) #None] + (case (get-meta ["lux" "export?"] def-meta) + (#Some [_ (#Bool true)]) (list name) _ @@ -4420,8 +4390,23 @@ ($_ text/compose prefix "." name) )) -(macro: #hidden (^open' tokens) +(macro: #export (^open tokens) + {#.doc "## Same as the \"open\" macro, but meant to be used as a pattern-matching macro for generating local bindings. + ## Can optionally take a \"prefix\" text for the generated local bindings. + (def: #export (range (^open) from to) + (All [a] (-> (Enum a) a a (List a))) + (range' <= succ from to))"} (case tokens + (^ (list& [_ (#Form (list))] body branches)) + (do Monad<Meta> + [g!temp (gensym "temp")] + (wrap (list& (symbol$ g!temp) (` (..^open (~@ g!temp) "" (~ body))) branches))) + + (^ (list& [_ (#Form (list [_ (#Text prefix)]))] body branches)) + (do Monad<Meta> + [g!temp (gensym "temp")] + (wrap (list& (symbol$ g!temp) (` (..^open (~@ g!temp) (~ (text$ prefix)) (~ body))) branches))) + (^ (list [_ (#Symbol name)] [_ (#Text prefix)] body)) (do Monad<Meta> [init-type (find-type name) @@ -4460,24 +4445,6 @@ _ (fail "Wrong syntax for ^open"))) -(macro: #export (^open tokens) - {#.doc "## Same as the \"open\" macro, but meant to be used as a pattern-matching macro for generating local bindings. - ## Can optionally take a \"prefix\" text for the generated local bindings. - (def: #export (range (^open) from to) - (All [a] (-> (Enum a) a a (List a))) - (range' <= succ from to))"} - (case tokens - (^ (list& [_ (#Form (list [_ (#Text prefix)]))] body branches)) - (do Monad<Meta> - [g!temp (gensym "temp")] - (return (list& (symbol$ g!temp) (` (^open' (~@ g!temp) (~ (text$ prefix)) (~ body))) branches))) - - (^ (list& [_ (#Form (list))] body branches)) - (return (list& (` (..^open "")) body branches)) - - _ - (fail "Wrong syntax for ^open"))) - (macro: #export (cond tokens) {#.doc "## Branching structures with multiple test conditions. (cond (n/even? num) \"even\" @@ -4721,7 +4688,7 @@ (wrap (list/compose defs openings)) )) -(macro: #hidden (refer tokens) +(macro: #export (refer tokens) (case tokens (^ (list& [_ (#Text module-name)] options)) (do Monad<Meta> @@ -5793,36 +5760,6 @@ _ (fail "Wrong syntax for type-of"))) -(type: #hidden Export-Level' - #Export - #Hidden) - -(def: (parse-export-level tokens) - (-> (List Code) (Meta [(Maybe Export-Level') (List Code)])) - (case tokens - (^ (list& [_ (#Tag ["" "export"])] tokens')) - (return [(#Some #Export) tokens']) - - (^ (list& [_ (#Tag ["" "hidden"])] tokens')) - (return [(#Some #Hidden) tokens']) - - _ - (return [#None tokens]) - )) - -(def: (gen-export-level ?export-level) - (-> (Maybe Export-Level') (List Code)) - (case ?export-level - #None - (list) - - (#Some #Export) - (list (' #export)) - - (#Some #Hidden) - (list (' #hidden)) - )) - (def: (parse-complex-declaration tokens) (-> (List Code) (Meta [[Text (List Text)] (List Code)])) (case tokens @@ -5879,8 +5816,7 @@ (template: (square x) (i/* x x)))} (do Monad<Meta> - [?export-level|tokens (parse-export-level tokens) - #let [[?export-level tokens] ?export-level|tokens] + [#let [[export? tokens] (export^ tokens)] name+args|tokens (parse-complex-declaration tokens) #let [[[name args] tokens] name+args|tokens] anns|tokens (parse-anns tokens) @@ -5894,7 +5830,7 @@ #let [rep-env (list/map (function [arg] [arg (` ((~' ~) (~ (symbol$ ["" arg]))))]) args)]] - (wrap (list (` (macro: (~+ (gen-export-level ?export-level)) + (wrap (list (` (macro: (~+ (export export?)) ((~ (symbol$ ["" name])) (~@ g!tokens) (~@ g!compiler)) (~ anns) (case (~@ g!tokens) diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux index 5aa8217e2..0e283122d 100644 --- a/stdlib/source/lux/cli.lux +++ b/stdlib/source/lux/cli.lux @@ -102,8 +102,6 @@ (wrap [(code.symbol ["" name]) (` any)])) (s.tuple (p.seq s.any s.any))))))) -(def: #hidden _Monad<CLI>_ p.Monad<Parser>) - (syntax: #export (program: [args program-args^] body) {#.doc (doc "Defines the entry-point to a program (similar to the \"main\" function/method in other programming languages)." "Can take a list of all the input parameters to the program, or can destructure them using CLI-option combinators from the lux/cli module." @@ -131,15 +129,15 @@ (with-gensyms [g!args g!_ g!output g!message] (wrap (list (` ("lux program" (~@ g!args) (case ((: (..CLI (io.IO Unit)) - (do .._Monad<CLI>_ - [(~+ (|> args - (list/map (function [[binding parser]] - (list binding parser))) - list/join)) - (~@ g!_) ..end] - ((~' wrap) (do io.Monad<IO> - [] - (~ body))))) + ((~! do) (~! p.Monad<Parser>) + [(~+ (|> args + (list/map (function [[binding parser]] + (list binding parser))) + list/join)) + (~@ g!_) ..end] + ((~' wrap) ((~! do) (~! io.Monad<IO>) + [] + (~ body))))) (~@ g!args)) (#E.Success [(~@ g!_) (~@ g!output)]) (~@ g!output) diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index 9f3403aad..694234d17 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -52,8 +52,10 @@ (io (let [[handle end] behavior self (: (Actor ($ +0)) (@abstract {#mailbox (stm.var (:! (Message ($ +0)) [])) - #kill-switch (P.promise Unit) - #obituary (P.promise (Obituary ($ +0)))})) + #kill-switch (: (P.Promise Unit) + (P.promise #.None)) + #obituary (: (P.Promise (Obituary ($ +0))) + (P.promise #.None))})) mailbox-channel (io.run (stm.follow (get@ #mailbox (@repr self)))) |mailbox| (stm.var mailbox-channel) _ (P/map (function [_] @@ -144,12 +146,12 @@ ## [Syntax] (do-template [<with> <resolve> <tag> <desc>] - [(def: #hidden (<with> name) + [(def: #export (<with> name) (-> Ident cs.Annotations cs.Annotations) (|>> (#.Cons [(ident-for <tag>) (code.tag name)]))) - (def: #hidden (<resolve> name) + (def: #export (<resolve> name) (-> Ident (Meta Ident)) (do Monad<Meta> [[_ annotations _] (macro.find-def name)] @@ -170,7 +172,7 @@ (p.seq s.local-symbol (:: p.Monad<Parser> wrap (list))))) (do-template [<name> <desc>] - [(def: #hidden <name> + [(def: #export <name> (-> Text Text) (|>> (format <desc> "@")))] diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/concurrency/frp.lux index 541b6530a..230eca335 100644 --- a/stdlib/source/lux/concurrency/frp.lux +++ b/stdlib/source/lux/concurrency/frp.lux @@ -24,7 +24,7 @@ {#.doc (doc "Makes an uninitialized Channel (in this case, of Nat)." (channel Nat))} (wrap (list (` (: (Channel (~ type)) - (&.promise' #.None)))))) + (&.promise #.None)))))) ## [Values] (def: #export (filter p xs) diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux index 0762694f9..2de5fa2c8 100644 --- a/stdlib/source/lux/concurrency/promise.lux +++ b/stdlib/source/lux/concurrency/promise.lux @@ -25,17 +25,11 @@ {#.doc "Represents values produced by asynchronous computations (unlike IO, which is synchronous)."} (Atom (Promise-State a))) -(def: #hidden (promise' ?value) +(def: #export (promise ?value) (All [a] (-> (Maybe a) (Promise a))) (atom {#value ?value #observers (list)})) -(syntax: #export (promise [type s.any]) - {#.doc (doc "Makes an uninitialized Promise (in this example, of Unit)." - (promise Unit))} - (wrap (list (` (: (Promise (~ type)) - (promise' #.None)))))) - (def: #export (poll promise) {#.doc "Polls a Promise's value."} (All [a] (-> (Promise a) (Maybe a))) @@ -88,7 +82,7 @@ (struct: #export _ (F.Functor Promise) (def: (map f fa) - (let [fb (promise ($ +1)) + (let [fb (: (Promise ($ +1)) (promise #.None)) ## fb (promise' #.None) ] (exec (await (function [a] (resolve (f a) fb)) @@ -103,7 +97,7 @@ #observers (list)})) (def: (apply ff fa) - (let [fb (promise ($ +1)) + (let [fb (: (Promise ($ +1)) (promise #.None)) ## fb (promise' #.None) ] (exec (await (function [f] @@ -117,7 +111,7 @@ (def: applicative Applicative<Promise>) (def: (join mma) - (let [ma (promise ($ +0)) + (let [ma (: (Promise ($ +0)) (promise #.None)) ## ma (promise' #.None) ] (exec (await (function [ma'] @@ -137,7 +131,7 @@ (def: #export (alt left right) {#.doc "Heterogeneous alternative combinator."} (All [a b] (-> (Promise a) (Promise b) (Promise (| a b)))) - (let [a|b (promise (| ($ +0) ($ +1))) + (let [a|b (: (Promise (| ($ +0) ($ +1))) (promise #.None)) ## a|b (promise' #.None) ] (with-expansions @@ -154,7 +148,7 @@ (def: #export (either left right) {#.doc "Homogeneous alternative combinator."} (All [a] (-> (Promise a) (Promise a) (Promise a))) - (let [left||right (promise ($ +0)) + (let [left||right (: (Promise ($ +0)) (promise #.None)) ## left||right (promise' #.None) ] (`` (exec (~~ (do-template [<promise>] @@ -168,7 +162,7 @@ (def: #export (future computation) {#.doc "Runs an I/O computation on its own process and returns an Promise that will eventually host its result."} (All [a] (-> (IO a) (Promise a))) - (let [!out (promise ($ +0)) + (let [!out (: (Promise ($ +0)) (promise #.None)) ## !out (promise' #.None) ] (exec ("lux process future" (io (io.run (resolve (io.run computation) @@ -178,7 +172,7 @@ (def: #export (wait time) {#.doc "Returns a Promise that will be resolved after the specified amount of milliseconds."} (-> Nat (Promise Unit)) - (let [!out (promise Unit)] + (let [!out (: (Promise Unit) (promise #.None))] (exec ("lux process schedule" time (resolve [] !out)) !out))) diff --git a/stdlib/source/lux/concurrency/space.lux b/stdlib/source/lux/concurrency/space.lux index 388415c44..fb7f199f8 100644 --- a/stdlib/source/lux/concurrency/space.lux +++ b/stdlib/source/lux/concurrency/space.lux @@ -105,8 +105,6 @@ (p.either (s.tuple (p.some s.local-symbol)) (:: p.Monad<Parser> wrap (list)))) -(def: #hidden _future P.future) - (syntax: #export (on: [export csr.export] [t-vars type-vars^] [[actor-name actor-params] reference^] @@ -145,7 +143,7 @@ (All [(~+ (L/map code.local-symbol t-vars))] (..Action (~ eventT) (~ stateT))) (T.from-promise - (_future + ((~! P.future) (A.send (function [(~ g!state) (~ g!receiverL)] (: (T.Task (~ stateT)) (monad.do T.Monad<Task> diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux index f7c7664f1..cc39ae0c3 100644 --- a/stdlib/source/lux/concurrency/stm.lux +++ b/stdlib/source/lux/concurrency/stm.lux @@ -264,7 +264,7 @@ For this reason, it's important to note that transactions must be free from side-effects, such as I/O."} (All [a] (-> (STM a) (P.Promise a))) - (let [output (P.promise ($ +0))] + (let [output (: (P.Promise ($ +0)) (P.promise #.None))] (exec (io.run init-processor!) (io.run (write! [stm-proc output] pending-commits)) output))) diff --git a/stdlib/source/lux/concurrency/task.lux b/stdlib/source/lux/concurrency/task.lux index 7f1322bf4..a740d7398 100644 --- a/stdlib/source/lux/concurrency/task.lux +++ b/stdlib/source/lux/concurrency/task.lux @@ -72,7 +72,7 @@ {#.doc (doc "Makes an uninitialized Task (in this example, of Unit)." (task Unit))} (wrap (list (` (: (..Task (~ type)) - (P.promise' #.None)))))) + (P.promise #.None)))))) (def: #export (from-promise promise) (All [a] (-> (P.Promise a) (Task a))) diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index da2e11710..d4716709b 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -86,9 +86,9 @@ (-> (~ (de-alias inputC)) (~ (de-alias outputC)))))))))))) -(def: #hidden begin! Unit []) +(def: begin! Unit []) -(def: #hidden end! +(def: end! (All [a] (-> [Unit a] a)) (function [[_ top]] top)) @@ -110,7 +110,7 @@ command)) (syntax: #export (||> [commands (p.some s.any)]) - (wrap (list (` (|> ..begin! (~+ (list/map prepare commands)) ..end!))))) + (wrap (list (` (|> (~! ..begin!) (~+ (list/map prepare commands)) (~! ..end!)))))) (syntax: #export (word: [export csr.export] [name s.local-symbol] [annotations (p.default cs.empty-annotations csr.annotations)] diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index dcac4fc6d..fcee396e1 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -17,10 +17,6 @@ (-> Text Text)) ## [Values] -(def: #hidden _text/compose_ - (-> Text Text Text) - text/compose) - (def: #export (match? exception error) (-> Exception Text Bool) (text.starts-with? (exception "") error)) @@ -76,4 +72,4 @@ g!message (code.symbol ["" "message"])]] (wrap (list (` (def: (~+ (csw.export _ex-lev)) ((~ (code.symbol ["" name])) (~ g!message)) Exception - (_text/compose_ (~ (code.text descriptor)) (~ g!message)))))))) + ((~! text/compose) (~ (code.text descriptor)) (~ g!message)))))))) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 2e9a1ec8a..49a739b4f 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -356,7 +356,7 @@ ############################################################ ############################################################ -(def: #hidden (show-null _) (-> Null Text) "null") +(def: (show-null _) (-> Null Text) "null") (do-template [<name> <type> <codec>] [(def: <name> (-> <type> Text) <codec>)] diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux index 54be54080..eba490617 100644 --- a/stdlib/source/lux/data/lazy.lux +++ b/stdlib/source/lux/data/lazy.lux @@ -12,7 +12,7 @@ (abstract: #export (Lazy a) (-> [] a) - (def: #hidden (freeze' generator) + (def: (freeze' generator) (All [a] (-> (-> [] a) (Lazy a))) (let [cache (atom.atom (: (Maybe ($ +0)) #.None))] (@abstract (function [_] @@ -31,7 +31,7 @@ (syntax: #export (freeze expr) (with-gensyms [g!_] - (wrap (list (` (freeze' (function [(~@ g!_)] (~ expr)))))))) + (wrap (list (` ((~! freeze') (function [(~@ g!_)] (~ expr)))))))) (struct: #export _ (Functor Lazy) (def: (map f fa) diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux index 6f5b64f5e..8342c9d28 100644 --- a/stdlib/source/lux/data/number/ratio.lux +++ b/stdlib/source/lux/data/number/ratio.lux @@ -21,7 +21,7 @@ {#numerator Nat #denominator Nat}) -(def: #hidden (normalize (^slots [#numerator #denominator])) +(def: (normalize (^slots [#numerator #denominator])) (-> Ratio Ratio) (let [common (math.gcd numerator denominator)] {#numerator (n// common numerator) @@ -155,6 +155,6 @@ (ratio numerator denominator) "The denominator can be omitted if it's 1." (ratio numerator))} - (wrap (list (` (normalize {#..numerator (~ numerator) - #..denominator (~ (maybe.default (' +1) - ?denominator))}))))) + (wrap (list (` ((~! normalize) {#..numerator (~ numerator) + #..denominator (~ (maybe.default (' +1) + ?denominator))}))))) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index f70a109f8..8068a3366 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -19,14 +19,12 @@ )) ## [Syntax] -(def: #hidden _compose_ - (-> Text Text Text) - (:: text.Monoid<Text> compose)) - (syntax: #export (format [fragments (p.many s.any)]) {#.doc (doc "Text interpolation." (format "Static part " (%t static) " does not match URI: " uri))} - (wrap (list (` ($_ _compose_ (~+ fragments)))))) + (macro.with-gensyms [g!compose] + (wrap (list (` (let [(~@ g!compose) (:: (~! text.Monoid<Text>) (~' compose))] + ($_ (~@ g!compose) (~+ fragments)))))))) ## [Formatters] (type: #export (Formatter a) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index bee56b728..45f1f8f69 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -27,23 +27,23 @@ l.any regex-char^))) -(def: #hidden (refine^ refinement^ base^) +(def: (refine^ refinement^ base^) (All [a] (-> (l.Lexer a) (l.Lexer Text) (l.Lexer Text))) (do p.Monad<Parser> [output base^ _ (l.local output refinement^)] (wrap output))) -(def: #hidden word^ +(def: word^ (l.Lexer Text) (p.either l.alpha-num (l.one-of "_"))) -(def: #hidden (copy reference) +(def: (copy reference) (-> Text (l.Lexer Text)) (p.after (l.this reference) (p/wrap reference))) -(def: #hidden (join-text^ part^) +(def: (join-text^ part^) (-> (l.Lexer (List Text)) (l.Lexer Text)) (do p.Monad<Parser> [parts part^] @@ -87,7 +87,7 @@ (l.Lexer Code) (do p.Monad<Parser> [char escaped-char^] - (wrap (` (..copy (~ (code.text char))))))) + (wrap (` ((~! ..copy) (~ (code.text char))))))) (def: re-options^ (l.Lexer Code) @@ -113,32 +113,32 @@ init re-user-class^' rest (p.some (p.after (l.this "&&") (l.enclosed ["[" "]"] re-user-class^')))] (wrap (list/fold (function [refinement base] - (` (refine^ (~ refinement) (~ base)))) + (` ((~! refine^) (~ refinement) (~ base)))) init rest)))) -(def: #hidden blank^ +(def: blank^ (l.Lexer Text) (l.one-of " \t")) -(def: #hidden ascii^ +(def: ascii^ (l.Lexer Text) (l.range (char "\u0000") (char "\u007F"))) -(def: #hidden control^ +(def: control^ (l.Lexer Text) (p.either (l.range (char "\u0000") (char "\u001F")) (l.one-of "\u007F"))) -(def: #hidden punct^ +(def: punct^ (l.Lexer Text) (l.one-of "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~")) -(def: #hidden graph^ +(def: graph^ (l.Lexer Text) (p.either punct^ l.alpha-num)) -(def: #hidden print^ +(def: print^ (l.Lexer Text) (p.either graph^ (l.one-of "\u0020"))) @@ -153,8 +153,8 @@ (p.after (l.this "\\D") (wrap (` (l.not l.decimal)))) (p.after (l.this "\\s") (wrap (` l.space))) (p.after (l.this "\\S") (wrap (` (l.not l.space)))) - (p.after (l.this "\\w") (wrap (` word^))) - (p.after (l.this "\\W") (wrap (` (l.not word^)))) + (p.after (l.this "\\w") (wrap (` (~! word^)))) + (p.after (l.this "\\W") (wrap (` (l.not (~! word^))))) (p.after (l.this "\\p{Lower}") (wrap (` l.lower))) (p.after (l.this "\\p{Upper}") (wrap (` l.upper))) @@ -164,12 +164,12 @@ (p.after (l.this "\\p{Space}") (wrap (` l.space))) (p.after (l.this "\\p{HexDigit}") (wrap (` l.hexadecimal))) (p.after (l.this "\\p{OctDigit}") (wrap (` l.octal))) - (p.after (l.this "\\p{Blank}") (wrap (` blank^))) - (p.after (l.this "\\p{ASCII}") (wrap (` ascii^))) - (p.after (l.this "\\p{Contrl}") (wrap (` control^))) - (p.after (l.this "\\p{Punct}") (wrap (` punct^))) - (p.after (l.this "\\p{Graph}") (wrap (` graph^))) - (p.after (l.this "\\p{Print}") (wrap (` print^))) + (p.after (l.this "\\p{Blank}") (wrap (` (~! blank^)))) + (p.after (l.this "\\p{ASCII}") (wrap (` (~! ascii^)))) + (p.after (l.this "\\p{Contrl}") (wrap (` (~! control^)))) + (p.after (l.this "\\p{Punct}") (wrap (` (~! punct^)))) + (p.after (l.this "\\p{Graph}") (wrap (` (~! graph^)))) + (p.after (l.this "\\p{Print}") (wrap (` (~! print^)))) ))) (def: re-class^ @@ -188,12 +188,12 @@ (p.either (do p.Monad<Parser> [_ (l.this "\\") id number^] - (wrap (` (..copy (~ (code.symbol ["" (int/encode (nat-to-int id))])))))) + (wrap (` ((~! ..copy) (~ (code.symbol ["" (int/encode (nat-to-int id))])))))) (do p.Monad<Parser> [_ (l.this "\\k<") captured-name identifier-part^ _ (l.this ">")] - (wrap (` (..copy (~ (code.symbol ["" captured-name])))))))) + (wrap (` ((~! ..copy) (~ (code.symbol ["" captured-name])))))))) (def: (re-simple^ current-module) (-> Text (l.Lexer Code)) @@ -214,11 +214,11 @@ (wrap (` (p.default "" (~ base)))) "*" - (wrap (` (join-text^ (p.some (~ base))))) + (wrap (` ((~! join-text^) (p.some (~ base))))) ## "+" _ - (wrap (` (join-text^ (p.many (~ base))))) + (wrap (` ((~! join-text^) (p.many (~ base))))) ))) (def: (re-counted-quantified^ current-module) @@ -229,18 +229,18 @@ ($_ p.either (do @ [[from to] (p.seq number^ (p.after (l.this ",") number^))] - (wrap (` (join-text^ (p.between (~ (code.nat from)) - (~ (code.nat to)) - (~ base)))))) + (wrap (` ((~! join-text^) (p.between (~ (code.nat from)) + (~ (code.nat to)) + (~ base)))))) (do @ [limit (p.after (l.this ",") number^)] - (wrap (` (join-text^ (p.at-most (~ (code.nat limit)) (~ base)))))) + (wrap (` ((~! join-text^) (p.at-most (~ (code.nat limit)) (~ base)))))) (do @ [limit (p.before (l.this ",") number^)] - (wrap (` (join-text^ (p.at-least (~ (code.nat limit)) (~ base)))))) + (wrap (` ((~! join-text^) (p.at-least (~ (code.nat limit)) (~ base)))))) (do @ [limit number^] - (wrap (` (join-text^ (p.exactly (~ (code.nat limit)) (~ base)))))))))) + (wrap (` ((~! join-text^) (p.exactly (~ (code.nat limit)) (~ base)))))))))) (def: (re-quantified^ current-module) (-> Text (l.Lexer Code)) @@ -253,10 +253,6 @@ (re-quantified^ current-module) (re-simple^ current-module))) -(def: #hidden _text/compose_ - (-> Text Text Text) - (:: text.Monoid<Text> compose)) - (type: Re-Group #Non-Capturing (#Capturing [(Maybe Text) Nat])) @@ -280,7 +276,7 @@ [idx names (list& (list g!temp complex - (' #let) (` [(~ g!total) (_text/compose_ (~ g!total) (~ g!temp))])) + (' #let) (` [(~ g!total) (:: (~! text.Monoid<Text>) (~' compose) (~ g!total) (~ g!temp))])) steps)] (#e.Success [(#Capturing [?name num-captures]) scoped]) @@ -296,7 +292,7 @@ [idx! (list& name! names) (list& (list name! scoped - (' #let) (` [(~ g!total) (_text/compose_ (~ g!total) (~ access))])) + (' #let) (` [(~ g!total) (:: (~! text.Monoid<Text>) (~' compose) (~ g!total) (~ access))])) steps)]) ))) [0 @@ -312,11 +308,11 @@ ((~ (' wrap)) [(~ g!total) (~+ (list.reverse names))])))]) )) -(def: #hidden (unflatten^ lexer) +(def: (unflatten^ lexer) (-> (l.Lexer Text) (l.Lexer [Text Unit])) (p.seq lexer (:: p.Monad<Parser> wrap []))) -(def: #hidden (|||^ left right) +(def: (|||^ left right) (All [l r] (-> (l.Lexer [Text l]) (l.Lexer [Text r]) (l.Lexer [Text (| l r)]))) (function [input] (case (left input) @@ -331,7 +327,7 @@ (#e.Error error) (#e.Error error))))) -(def: #hidden (|||_^ left right) +(def: (|||_^ left right) (All [l r] (-> (l.Lexer [Text l]) (l.Lexer [Text r]) (l.Lexer Text))) (function [input] (case (left input) @@ -350,7 +346,7 @@ (-> [Nat Code] Code) (if (n/> +0 num-captures) alt - (` (unflatten^ (~ alt))))) + (` ((~! unflatten^) (~ alt))))) (def: (re-alternative^ capturing? re-scoped^ current-module) (-> Bool @@ -361,13 +357,16 @@ [#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)] head sub^ tail (p.some (p.after (l.this "|") sub^)) - #let [g!op (if capturing? - (` |||^) - (` |||_^))]] + #let [g!op ["" " alt "]]] (if (list.empty? tail) (wrap head) (wrap [(list/fold n/max (product.left head) (list/map product.left tail)) - (` ($_ (~ g!op) (~ (prep-alternative head)) (~+ (list/map prep-alternative tail))))])))) + (` (let [(~@ g!op) (~ (if capturing? + (` (~! |||^)) + (` (~! |||_^))))] + ($_ (~@ g!op) + (~ (prep-alternative head)) + (~+ (list/map prep-alternative tail)))))])))) (def: (re-scoped^ current-module) (-> Text (l.Lexer [Re-Group Code])) @@ -486,7 +485,7 @@ do-something-else))} (with-gensyms [g!temp] (wrap (list& (` (^multi (~@ g!temp) - [(l.run (~@ g!temp) (regex (~ (code.text pattern)))) + [((~! l.run) (~@ g!temp) (regex (~ (code.text pattern)))) (#e.Success (~ (maybe.default (code.symbol g!temp) bindings)))])) body diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 384a723c9..859bfe3e3 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -197,7 +197,6 @@ (flag-set? (ident-for <tag>)))] [export? #.export? "exported"] - [hidden? #.hidden? "hidden"] [macro? #.macro? "a macro"] [type? #.type? "a type"] [struct? #.struct? "a structure"] @@ -524,8 +523,7 @@ (do Monad<Meta> [defs (defs module-name)] (wrap (list.filter (function [[name [def-type def-anns def-value]]] - (and (export? def-anns) - (not (hidden? def-anns)))) + (export? def-anns)) defs)))) (def: #export modules diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index a81ca1bb4..3455a6672 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -28,15 +28,11 @@ (lang [type]) )) -(def: #hidden _map_ - (All [a b] (-> (-> a b) (List a) (List b))) - list/map) - (def: tag (-> Nat Frac) (|>> nat-to-int int-to-frac)) -(def: #hidden (rec-encode non-rec) +(def: (rec-encode non-rec) (All [a] (-> (-> (-> a JSON) (-> a JSON)) (-> a JSON))) @@ -46,7 +42,7 @@ (def: low-mask Nat (|> +1 (bit.shift-left +32) n/dec)) (def: high-mask Nat (|> low-mask (bit.shift-left +32))) -(struct: #hidden _ (Codec JSON Nat) +(struct: _ (Codec JSON Nat) (def: (encode input) (let [high (|> input (bit.and high-mask) (bit.shift-right +32)) low (bit.and low-mask input)] @@ -60,12 +56,12 @@ (wrap (n/+ (|> high frac-to-int int-to-nat (bit.shift-left +32)) (|> low frac-to-int int-to-nat)))))) -(struct: #hidden _ (Codec JSON Int) +(struct: _ (Codec JSON Int) (def: encode (|>> int-to-nat (:: Codec<JSON,Nat> encode))) (def: decode (|>> (:: Codec<JSON,Nat> decode) (:: e.Functor<Error> map nat-to-int)))) -(def: #hidden (nullable writer) +(def: (nullable writer) {#.doc "Builds a JSON generator for potentially inexistent values."} (All [a] (-> (-> a JSON) (-> (Maybe a) JSON))) (function [elem] @@ -73,14 +69,14 @@ #.None #//.Null (#.Some value) (writer value)))) -(struct: #hidden (Codec<JSON,Qty> carrier) +(struct: (Codec<JSON,Qty> carrier) (All [unit] (-> unit (Codec JSON (unit.Qty unit)))) (def: encode (|>> unit.out (:: Codec<JSON,Int> encode))) (def: decode (|>> (:: Codec<JSON,Int> decode) (:: e.Functor<Error> map (unit.in carrier))))) -(poly: #hidden Codec<JSON,?>//encode +(poly: Codec<JSON,?>//encode (with-expansions [<basic> (do-template [<type> <matcher> <encoder>] [(do @ @@ -90,8 +86,8 @@ [Unit poly.unit (function [(~ (code.symbol ["" "0"]))] #//.Null)] [Bool poly.bool (|>> #//.Boolean)] - [Nat poly.nat (:: ..Codec<JSON,Nat> (~' encode))] - [Int poly.int (:: ..Codec<JSON,Int> (~' encode))] + [Nat poly.nat (:: (~! ..Codec<JSON,Nat>) (~' encode))] + [Int poly.int (:: (~! ..Codec<JSON,Int>) (~' encode))] [Frac poly.frac (|>> #//.Number)] [Text poly.text (|>> #//.String)]) <time> (do-template [<type> <codec>] @@ -118,7 +114,7 @@ [unitT (poly.apply (p.after (poly.this unit.Qty) poly.any))] (wrap (` (: (~ (@JSON//encode inputT)) - (:: (Codec<JSON,Qty> (:! (~ (poly.to-ast *env* unitT)) [])) (~' encode)))))) + (:: ((~! Codec<JSON,Qty>) (:! (~ (poly.to-ast *env* unitT)) [])) (~' encode)))))) (do @ [#let [g!key (code.local-symbol "\u0000key") g!val (code.local-symbol "\u0000val")] @@ -128,8 +124,8 @@ Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) (|>> d.entries - (.._map_ (function [[(~ g!key) (~ g!val)]] - [(~ g!key) ((~ =val=) (~ g!val))])) + ((~! list/map) (function [[(~ g!key) (~ g!val)]] + [(~ g!key) ((~ =val=) (~ g!val))])) (d.from-list text.Hash<Text>) #//.Object))))) (do @ @@ -137,13 +133,13 @@ (poly.this .Maybe) Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) - (..nullable (~ =sub=)))))) + ((~! ..nullable) (~ =sub=)))))) (do @ [[_ =sub=] (poly.apply ($_ p.seq (poly.this .List) Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) - (|>> (.._map_ (~ =sub=)) sequence.from-list #//.Array))))) + (|>> ((~! list/map) (~ =sub=)) sequence.from-list #//.Array))))) (do @ [#let [g!input (code.local-symbol "\u0000input")] members (poly.variant (p.many Codec<JSON,?>//encode))] @@ -169,8 +165,8 @@ (do @ [[selfC non-recC] (poly.recursive Codec<JSON,?>//encode)] (wrap (` (: (~ (@JSON//encode inputT)) - (..rec-encode (.function [(~ selfC)] - (~ non-recC))))))) + ((~! ..rec-encode) (.function [(~ selfC)] + (~ non-recC))))))) poly.recursive-self ## Type applications (do @ @@ -192,7 +188,7 @@ (p.fail (text/compose "Cannot create JSON encoder for: " (type.to-text inputT))) )))) -(poly: #hidden Codec<JSON,?>//decode +(poly: Codec<JSON,?>//decode (with-expansions [<basic> (do-template [<type> <matcher> <decoder>] [(do @ @@ -202,8 +198,8 @@ [Unit poly.unit //.null] [Bool poly.bool //.boolean] - [Nat poly.nat (p.codec ..Codec<JSON,Nat> //.any)] - [Int poly.int (p.codec ..Codec<JSON,Int> //.any)] + [Nat poly.nat (p.codec (~! ..Codec<JSON,Nat>) //.any)] + [Int poly.int (p.codec (~! ..Codec<JSON,Int>) //.any)] [Frac poly.frac //.number] [Text poly.text //.string]) <time> (do-template [<type> <codec>] @@ -230,7 +226,7 @@ [unitT (poly.apply (p.after (poly.this unit.Qty) poly.any))] (wrap (` (: (~ (@JSON//decode inputT)) - (p.codec (Codec<JSON,Qty> (:! (~ (poly.to-ast *env* unitT)) [])) //.any))))) + (p.codec ((~! Codec<JSON,Qty>) (:! (~ (poly.to-ast *env* unitT)) [])) //.any))))) (do @ [[_ _ valC] (poly.apply ($_ p.seq (poly.this d.Dict) @@ -307,6 +303,6 @@ (derived: (Codec<JSON,?> Record)))} (with-gensyms [g!inputs] (wrap (list (` (: (Codec //.JSON (~ inputT)) - (struct (def: (~' encode) (Codec<JSON,?>//encode (~ inputT))) - (def: ((~' decode) (~@ g!inputs)) (//.run (~@ g!inputs) (Codec<JSON,?>//decode (~ inputT)))) + (struct (def: (~' encode) ((~! Codec<JSON,?>//encode) (~ inputT))) + (def: ((~' decode) (~@ g!inputs)) (//.run (~@ g!inputs) ((~! Codec<JSON,?>//decode) (~ inputT)))) ))))))) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 48fd00a7c..5cd68ccb9 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -194,11 +194,6 @@ (wrap [real value])))) ## [Syntax] -(def: #hidden text/join-with text.join-with) - -(def: #hidden _run_ p.run) -(def: #hidden _Monad<Parser>_ p.Monad<Parser>) - (macro: #export (syntax: tokens) {#.doc (doc "A more advanced way to define macros than \"macro:\"." "The inputs to the macro can be parsed in complex ways through the use of syntax parsers." @@ -216,16 +211,13 @@ (with-brackets (spaced (list/map constructor-arg$ constructor-args))) (with-brackets (spaced (list/map (method-def$ id) methods))))))] (wrap (list (` ((~ (code.text def-code)))))))))} - (let [[exported? tokens] (: [(Maybe (Either Unit Unit)) (List Code)] + (let [[exported? tokens] (: [Bool (List Code)] (case tokens - (^ (list& [_ (#.Tag ["" "hidden"])] tokens')) - [(#.Some #.Left) tokens'] - (^ (list& [_ (#.Tag ["" "export"])] tokens')) - [(#.Some #.Right) tokens'] + [true tokens'] _ - [#.None tokens])) + [false tokens])) ?parts (: (Maybe [Text (List Code) Code Code]) (case tokens (^ (list [_ (#.Form (list& [_ (#.Symbol ["" name])] args))] @@ -241,7 +233,7 @@ #.None))] (case ?parts (#.Some [name args meta body]) - (with-gensyms [g!tokens g!body g!msg] + (with-gensyms [g!text/join-with g!tokens g!body g!msg] (do macro.Monad<Meta> [vars+parsers (monad.map @ (: (-> Code (Meta [Code Code])) @@ -258,29 +250,25 @@ args) #let [g!state ["" "*compiler*"] error-msg (code.text (text/compose "Wrong syntax for " name)) - export-ast (: (List Code) (case exported? - (#.Some #.Left) - (list (' #hidden)) - - (#.Some #.Right) - (list (' #export)) - - _ - (list)))]] + export-ast (: (List Code) + (if exported? + (list (' #export)) + (list)))]] (wrap (list (` (macro: (~+ export-ast) ((~ (code.symbol ["" name])) (~@ g!tokens) (~@ g!state)) (~ meta) ("lux case" (..run (~@ g!tokens) (: (Syntax (Meta (List Code))) - (do .._Monad<Parser>_ + (do (~! p.Monad<Parser>) [(~+ (join-pairs vars+parsers))] - ((~' wrap) (do macro.Monad<Meta> + ((~' wrap) (do (~! macro.Monad<Meta>) [] (~ body)))))) {(#E.Success (~@ g!body)) ((~@ g!body) (~@ g!state)) (#E.Error (~@ g!msg)) - (#E.Error (text/join-with ": " (list (~ error-msg) (~@ g!msg))))}))))))) + (let [(~@ g!text/join-with) (~! text.join-with)] + (#E.Error ((~@ g!text/join-with) ": " (list (~ error-msg) (~@ g!msg)))))}))))))) _ (macro.fail "Wrong syntax for syntax:")))) diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux index 8c684537e..9de36fe5d 100644 --- a/stdlib/source/lux/macro/syntax/common.lux +++ b/stdlib/source/lux/macro/syntax/common.lux @@ -3,10 +3,6 @@ The goal is to be able to reuse common syntax in macro definitions across libraries."} lux) -(type: #export Export - #Exported - #Hidden) - (type: #export Declaration {#declaration-name Text #declaration-args (List Text)}) diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux index ac6d876c3..0e8b5df9a 100644 --- a/stdlib/source/lux/macro/syntax/common/reader.lux +++ b/stdlib/source/lux/macro/syntax/common/reader.lux @@ -1,7 +1,7 @@ (.module: {#.doc "Commons syntax readers."} lux (lux (control monad - ["p" parser]) + ["p" parser "p/" Monad<Parser>]) (data (coll [list]) [ident "ident/" Eq<Ident>] [product] @@ -12,13 +12,9 @@ ## Exports (def: #export export - {#.doc (doc "A reader for export levels." - "Such as:" - #export - #hidden)} - (Syntax (Maybe Export)) - (p.maybe (p.alt (s.this (' #export)) - (s.this (' #hidden))))) + (Syntax Bool) + (p.either (p.after (s.this (' #export)) (p/wrap true)) + (p/wrap false))) ## Declarations (def: #export declaration @@ -28,7 +24,7 @@ (foo bar baz))} (Syntax Declaration) (p.either (p.seq s.local-symbol - (:: p.Monad<Parser> wrap (list))) + (p/wrap (list))) (s.form (p.seq s.local-symbol (p.many s.local-symbol))))) @@ -46,7 +42,7 @@ type s.any value s.any] (wrap [(#.Some type) value]))) - (p.seq (:: p.Monad<Parser> wrap #.None) + (p.seq (p/wrap #.None) s.any))) (def: _definition-anns-tag^ diff --git a/stdlib/source/lux/macro/syntax/common/writer.lux b/stdlib/source/lux/macro/syntax/common/writer.lux index d5ad8cb61..5b5ab9ab5 100644 --- a/stdlib/source/lux/macro/syntax/common/writer.lux +++ b/stdlib/source/lux/macro/syntax/common/writer.lux @@ -1,24 +1,18 @@ (.module: {#.doc "Commons syntax writers."} lux - (lux (data (coll [list "L/" Functor<List>]) + (lux (data (coll [list "list/" Functor<List>]) [product]) (macro [code])) [// #*]) ## Exports -(def: #export (export ?el) - (-> (Maybe Export) (List Code)) - (case ?el - #.None - (list) - - (#.Some #//.Exported) +(def: #export (export exported?) + (-> Bool (List Code)) + (if exported? (list (' #export)) - - (#.Some #//.Hidden) - (list (' #hidden)))) + (list))) ## Annotations (def: #export (annotations anns) (-> Annotations Code) - (|> anns (L/map (product.both code.tag id)) code.record)) + (|> anns (list/map (product.both code.tag id)) code.record)) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 7c24e22d5..57d5ae2f3 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -19,7 +19,7 @@ ## [Host] (do-template [<name> <signal>] - [(def: #hidden <name> (IO Bottom) + [(def: <name> (IO Bottom) (io ("lux io exit" <signal>)))] [exit 0] @@ -39,8 +39,6 @@ (def: pcg-32-magic-inc Nat +12345) ## [Values] -(def: #hidden Monad<Random> (Monad r.Random) r.Monad<Random>) - (def: success Counters [+1 +0]) (def: failure Counters [+0 +1]) (def: start Counters [+0 +0]) @@ -67,7 +65,7 @@ (-> Text Bool Test) (:: r.Monad<Random> wrap (assert message condition))) -(def: #hidden (run' tests) +(def: (run' tests) (-> (List [Text (IO Test) Text]) (Promise Counters)) (do Monad<Promise> [test-runs (|> tests @@ -120,8 +118,6 @@ (product.right (r.run prng' (times (n/dec amount) test)))))]))))) ## [Syntax] -(def: #hidden _code/text_ code.text) - (syntax: #export (context: description test) {#.doc (doc "Macro for definint tests." (context: "Simple macros and constructs" @@ -188,9 +184,9 @@ )} (with-gensyms [g!context g!test g!error] (wrap (list (` (def: #export (~@ g!context) - {#..test (.._code/text_ (~ description))} + {#..test ((~! code.text) (~ description))} (IO Test) - (io (case ("lux try" [(io (do ..Monad<Random> [] (~ test)))]) + (io (case ("lux try" [(io (do (~! r.Monad<Random>) [] (~ test)))]) (#.Right (~@ g!test)) (~@ g!test) @@ -212,13 +208,10 @@ (list.filter product.left) (list/map product.right))))) -(def: #hidden _composeT_ (-> Text Text Text) (:: text.Monoid<Text> compose)) -(def: #hidden _%i_ (-> Int Text) %i) - (syntax: #export (run) {#.doc (doc "Runs all the tests defined on the current module, and in all imported modules." (run))} - (with-gensyms [g!successes g!failures g!total-successes g!total-failures] + (with-gensyms [g!successes g!failures g!total-successes g!total-failures g!text/compose] (do @ [current-module macro.current-module-name modules (macro.imported-modules current-module) @@ -237,23 +230,24 @@ [(~' #let) [(~@ g!total-successes) +0 (~@ g!total-failures) +0] (~+ (list/join (list/map (function [group] - (list (` [(~@ g!successes) (~@ g!failures)]) (` (run' (list (~+ group)))) + (list (` [(~@ g!successes) (~@ g!failures)]) (` ((~! run') (list (~+ group)))) (' #let) (` [(~@ g!total-successes) (n/+ (~@ g!successes) (~@ g!total-successes)) (~@ g!total-failures) (n/+ (~@ g!failures) (~@ g!total-failures))]))) groups)))] - (exec (log! ($_ _composeT_ - "Test-suite finished." - "\n" - (_%i_ (nat-to-int (~@ g!total-successes))) - " out of " - (_%i_ (nat-to-int (n/+ (~@ g!total-failures) - (~@ g!total-successes)))) - " tests passed." - "\n" - (_%i_ (nat-to-int (~@ g!total-failures))) " tests failed.")) + (exec (let [(~@ g!text/compose) (:: (~! text.Monoid<Text>) (~' compose))] + (log! ($_ (~@ g!text/compose) + "Test-suite finished." + "\n" + ((~! %i) (nat-to-int (~@ g!total-successes))) + " out of " + ((~! %i) (nat-to-int (n/+ (~@ g!total-failures) + (~@ g!total-successes)))) + " tests passed." + "\n" + ((~! %i) (nat-to-int (~@ g!total-failures))) " tests failed."))) (promise.future (if (n/> +0 (~@ g!total-failures)) - ..die - ..exit)))) + (~! ..die) + (~! ..exit))))) []))))))))) (def: #export (seq left right) diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index 81f879f7b..cf6f1b4e4 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -107,8 +107,8 @@ (#E.Success [(update@ #.modules (put this-module-name this-module) compiler) []])))) -(syntax: #hidden (install-casts [name s.local-symbol] - [type-vars (s.tuple (p.some s.local-symbol))]) +(syntax: (install-casts [name s.local-symbol] + [type-vars (s.tuple (p.some s.local-symbol))]) (do @ [this-module-name macro.current-module-name ?down-cast (macro.find-macro [this-module-name down-cast]) @@ -125,7 +125,7 @@ down-cast " & " up-cast ") because definitions like that already exist."))))) -(syntax: #hidden (un-install-casts) +(syntax: (un-install-casts) (do macro.Monad<Meta> [this-module-name macro.current-module-name ?down-cast (macro.find-macro [this-module-name down-cast]) @@ -161,6 +161,6 @@ (primitive (~ (code.text hidden-name)) [(~+ type-varsC)]))) (` (type: (~+ (csw.export export)) (~ representation-declaration) (~ representation-type))) - (` (install-casts (~ (code.local-symbol name)) [(~+ type-varsC)])) + (` ((~! install-casts) (~ (code.local-symbol name)) [(~+ type-varsC)])) (list/compose primitives - (list (` (un-install-casts)))))))) + (list (` ((~! un-install-casts))))))))) diff --git a/stdlib/source/lux/type/object.lux b/stdlib/source/lux/type/object.lux index 03c3fb8a7..d46dd59d3 100644 --- a/stdlib/source/lux/type/object.lux +++ b/stdlib/source/lux/type/object.lux @@ -93,7 +93,7 @@ (~ g!method))))) (def: (definition export [interface parameters] g!self-object g!ext g!states (^open)) - (-> (Maybe cs.Export) Declaration Code Ident (List Code) Method Code) + (-> Bool Declaration Code Ident (List Code) Method Code) (let [g!method (code.local-symbol name) g!parameters (list/map code.local-symbol parameters) g!type-vars (list/map code.local-symbol type-vars) @@ -242,7 +242,7 @@ ) (def: (getterN export interface g!parameters g!ext g!child ancestors) - (-> (Maybe cs.Export) Text (List Code) Ident Ident (List Ident) + (-> Bool Text (List Code) Ident Ident (List Ident) Code) (let [g!get (code.local-symbol (getN interface)) g!interface (code.local-symbol interface) @@ -261,7 +261,7 @@ (~ g!_state)))))) (def: (setterN export interface g!parameters g!ext g!child ancestors) - (-> (Maybe cs.Export) Text (List Code) Ident Ident (List Ident) + (-> Bool Text (List Code) Ident Ident (List Ident) Code) (let [g!set (code.local-symbol (setN interface)) g!interface (code.local-symbol interface) @@ -284,7 +284,7 @@ (~ g!build-up)))))) (def: (updaterN export interface g!parameters g!ext g!child ancestors) - (-> (Maybe cs.Export) Text (List Code) Ident Ident (List Ident) + (-> Bool Text (List Code) Ident Ident (List Ident) Code) (let [g!update (code.local-symbol (updateN interface)) g!interface (code.local-symbol interface) diff --git a/stdlib/test/test/lux/concurrency/promise.lux b/stdlib/test/test/lux/concurrency/promise.lux index 3be2f03b5..37ba6f2e1 100644 --- a/stdlib/test/test/lux/concurrency/promise.lux +++ b/stdlib/test/test/lux/concurrency/promise.lux @@ -56,7 +56,7 @@ (test "Cannot re-resolve a resolved promise." (and (not (io.run (&.resolve false (&/wrap true)))) - (io.run (&.resolve true (&.promise Bool))))) + (io.run (&.resolve true (: (&.Promise Bool) (&.promise #.None)))))) (wrap (do &.Monad<Promise> [?none (&.time-out +100 (&.delay +200 true)) diff --git a/stdlib/test/test/lux/data/number/ratio.lux b/stdlib/test/test/lux/data/number/ratio.lux index 93081cd14..73e43e6c5 100644 --- a/stdlib/test/test/lux/data/number/ratio.lux +++ b/stdlib/test/test/lux/data/number/ratio.lux @@ -32,7 +32,10 @@ (&.ratio +0 denom2))) (test "All ratios are built normalized." - (|> sample &.normalize (&.r/= sample))) + (|> sample + &.normalize + ("lux in-module" "lux/data/number/ratio") + (&.r/= sample))) )))) (context: "Arithmetic" diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 2efff3c71..ad43cadfe 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -74,7 +74,8 @@ (world ["_." blob] ["_." file] (net ["_." tcp] - ["_." udp])))) + ["_." udp])) + )) (lux (control [contract] [concatenative]) (concurrency [space]) @@ -88,6 +89,7 @@ (coll (tree ["tree_." parser]))) (math [random]) [macro] + (macro (poly [json])) (type [unit]) [world/env] [world/console]) |