From 5b37fb8115ca7d82cb2ac9933dfdacd799390ae7 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 14 Jun 2018 18:28:59 -0400 Subject: - Minor refactorings. --- stdlib/source/lux/concurrency/atom.lux | 2 +- stdlib/source/lux/control/exception.lux | 4 +- stdlib/source/lux/control/predicate.lux | 2 +- stdlib/source/lux/function.lux | 2 +- stdlib/source/lux/macro.lux | 66 +++++++++++++++++++++------------ stdlib/source/lux/macro/poly.lux | 2 +- 6 files changed, 48 insertions(+), 30 deletions(-) diff --git a/stdlib/source/lux/concurrency/atom.lux b/stdlib/source/lux/concurrency/atom.lux index 10f7005d3..1c9091dc0 100644 --- a/stdlib/source/lux/concurrency/atom.lux +++ b/stdlib/source/lux/concurrency/atom.lux @@ -38,4 +38,4 @@ (def: #export (write value atom) (All [a] (-> a (Atom a) (IO Any))) - (update (function.const value) atom)) + (update (function.constant value) atom)) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index d866c153e..066a81d65 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -112,8 +112,8 @@ (list.repeat (n/- (text.size header) largest-header-size)) (text.join-with ""))] - ($_ text/compose padding header ": " message)))) - (text.join-with "\n")))) + ($_ text/compose padding header ": " message "\n")))) + (text.join-with "")))) (syntax: #export (report {entries (p.many (s.tuple (p.seq s.any s.any)))}) (wrap (list (` (report' (list (~+ (|> entries diff --git a/stdlib/source/lux/control/predicate.lux b/stdlib/source/lux/control/predicate.lux index 45ed4c984..f237f2e64 100644 --- a/stdlib/source/lux/control/predicate.lux +++ b/stdlib/source/lux/control/predicate.lux @@ -12,7 +12,7 @@ (do-template [ ] [(def: #export (All [a] (Pred a)) - (function.const )) + (function.constant )) (def: #export ( left right) (All [a] (-> (Pred a) (Pred a) (Pred a))) diff --git a/stdlib/source/lux/function.lux b/stdlib/source/lux/function.lux index f687f6fd5..919e19371 100644 --- a/stdlib/source/lux/function.lux +++ b/stdlib/source/lux/function.lux @@ -8,7 +8,7 @@ (-> (-> b c) (-> a b) (-> a c))) (|>> g f)) -(def: #export (const c) +(def: #export (constant c) {#.doc "Create constant functions."} (All [a b] (-> a (-> b a))) (function (_ _) c)) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 890ed5273..91a83864c 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -3,7 +3,7 @@ (lux (control [functor #+ Functor] [apply #+ Apply] [monad #+ do Monad]) - (data [number] + (data [number "nat/" Codec] [product] [ident "ident/" Codec Eq] [maybe] @@ -397,8 +397,8 @@ (function (_ name) (list (code.symbol ["" name]) (` (gensym (~ (code.text name))))))) symbol-names))]] (wrap (list (` ((~! do) (~! Monad) - [(~+ symbol-defs)] - (~ body)))))) + [(~+ symbol-defs)] + (~ body)))))) _ (fail "Wrong syntax for with-gensyms"))) @@ -673,6 +673,14 @@ (function (_ compiler) (#e.Success [compiler (get@ #.type-context compiler)]))) +(def: (cursor-description [file line column]) + (-> Cursor Text) + (|> (list (text.encode file) + (nat/encode line) + (nat/encode column)) + (text.join-with ", ") + (text.enclose ["[" "]"]))) + (do-template [ ] [(macro: #export ( tokens) {#.doc (doc "Performs a macro-expansion and logs the resulting code." @@ -682,23 +690,30 @@ (def: (foo bar baz) (-> Int Int Int) (i/+ bar baz))))} - (case tokens - (^ (list [_ (#.Tag ["" "omit"])] - token)) - (do Monad - [output ( token) - #let [_ (list/map (|>> code.to-text log!) - output)]] - (wrap (list))) - - (^ (list token)) + (case (: (Maybe [Bool Code]) + (case tokens + (^ (list [_ (#.Tag ["" "omit"])] + token)) + (#.Some [true token]) + + (^ (list token)) + (#.Some [false token]) + + _ + #.None)) + (#.Some [omit? token]) (do Monad - [output ( token) - #let [_ (list/map (|>> code.to-text log!) - output)]] - (wrap output)) - - _ + [cursor ..cursor + output ( token) + #let [_ (log! ($_ text/compose " @ " (cursor-description cursor))) + _ (list/map (|>> code.to-text log!) + output) + _ (log! "")]] + (wrap (if omit? + (list) + output))) + + #.None (fail ($_ text/compose "Wrong syntax for " "."))))] [log-expand expand "log-expand"] @@ -706,21 +721,24 @@ [log-expand-once expand-once "log-expand-once"] ) -(macro: #export (log-type tokens) +(macro: #export (log-type! tokens) (case tokens (#.Cons [_ (#.Symbol valueN)] #.Nil) (do Monad - [valueT (find-type valueN) - #let [_ (log! ($_ text/compose (code.to-text (code.symbol valueN)) " : " (type.to-text valueT)))]] + [cursor ..cursor + valueT (find-type valueN) + #let [_ (log! ($_ text/compose + "log-type!" " @ " (cursor-description cursor) "\n" + (code.to-text (code.symbol valueN)) " : " (type.to-text valueT) "\n"))]] (wrap (list (' [])))) (#.Cons valueC #.Nil) (|> (` (.let [(~ g!value) (~ valueC)] - (..log-type (~ g!value)))) + (..log-type! (~ g!value)))) (let [g!value (code.local-symbol (code.to-text valueC))]) list (:: Monad wrap)) _ - (fail "Wrong syntax for log-type.") + (fail "Wrong syntax for log-type!.") )) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 4c0363df0..39c3ffbbb 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -313,7 +313,7 @@ _ (local (list funcT) (var +0)) allC (let [allT (list& funcT argsT)] (|> allT - (monad.map @ (function.const bound)) + (monad.map @ (function.constant bound)) (local allT)))] (wrap (` ((~+ allC)))))) -- cgit v1.2.3