diff options
Diffstat (limited to 'source')
| -rw-r--r-- | source/lux.lux | 54 | ||||
| -rw-r--r-- | source/lux/control/comonad.lux | 3 | ||||
| -rw-r--r-- | source/lux/control/monad.lux | 2 | ||||
| -rw-r--r-- | source/lux/data/list.lux | 2 | ||||
| -rw-r--r-- | source/lux/data/text.lux | 2 | ||||
| -rw-r--r-- | source/lux/meta/lux.lux | 16 |
6 files changed, 47 insertions, 32 deletions
diff --git a/source/lux.lux b/source/lux.lux index d3dd374d5..798742e6f 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -2674,6 +2674,20 @@ #seed seed #eval? eval? #expected expected} state] (#Right state expected)))) +(def (use-field field-name type) + (-> Text Type (, Syntax Syntax)) + (let [[module name] (split-slot field-name) + pattern (: Syntax + (case (resolve-struct-type type) + (#Some (#RecordT slots)) + (record$ (map (: (-> (, Text Type) (, Syntax Syntax)) + (lambda [[sname stype]] (use-field sname stype))) + slots)) + + _ + (symbol$ ["" name])))] + [(tag$ [module name]) pattern])) + (defmacro #export (using tokens) (case tokens (\ (list struct body)) @@ -2684,10 +2698,7 @@ (case (resolve-struct-type struct-type) (#Some (#RecordT slots)) (let [pattern (record$ (map (: (-> (, Text Type) (, Syntax Syntax)) - (lambda [slot] - (let [[sname stype] slot - [module name] (split-slot sname)] - [(tag$ [module name]) (symbol$ ["" name])]))) + (lambda [[sname stype]] (use-field sname stype))) slots))] (return (list (` (_lux_case (~ struct) (~ pattern) (~ body)))))) @@ -2762,6 +2773,19 @@ _ (fail "Wrong syntax for get@"))) +(def (open-field prefix field-name source type) + (-> Text Text Syntax Type (List Syntax)) + (let [[module name] (split-slot field-name) + source+ (: Syntax (` (get@ (~ (tag$ [module name])) (~ source))))] + (case (resolve-struct-type type) + (#Some (#RecordT slots)) + (list:join (map (: (-> (, Text Type) (List Syntax)) + (lambda [[sname stype]] (open-field prefix sname source+ stype))) + slots)) + + _ + (list (` (_lux_def (~ (symbol$ ["" (text:++ prefix name)])) (~ source+))))))) + (defmacro #export (open tokens) (case tokens (\ (list& (#Meta _ (#SymbolS struct-name)) tokens')) @@ -2772,16 +2796,13 @@ _ "")] - struct-type (find-var-type struct-name)] + struct-type (find-var-type struct-name) + #let [source (symbol$ struct-name)]] (case (resolve-struct-type struct-type) (#Some (#RecordT slots)) - (return (map (: (-> (, Text Type) Syntax) - (lambda [slot] - (let [[sname stype] slot - [module name] (split-slot sname)] - (` (_lux_def (~ (symbol$ ["" (text:++ prefix name)])) - (get@ (~ (tag$ [module name])) (~ (symbol$ struct-name)))))))) - slots)) + (return (list:join (map (: (-> (, Text Type) (List Syntax)) + (lambda [[sname stype]] (open-field prefix sname source stype))) + slots))) _ (fail "Can only \"open\" records."))) @@ -3051,10 +3072,5 @@ _ (fail "Wrong syntax for loop"))) -## (defmacro #export (extend tokens) -## (case tokens -## (\ (list (#Meta _ (#SymbolS name)))) - - -## _ -## (fail "Wrong syntax for extend"))) +(defmacro #export (export tokens) + (return (map (lambda [token] (` (_lux_export (~ token)))) tokens))) diff --git a/source/lux/control/comonad.lux b/source/lux/control/comonad.lux index ce9a7e7de..a1168a3cd 100644 --- a/source/lux/control/comonad.lux +++ b/source/lux/control/comonad.lux @@ -27,8 +27,7 @@ (All [w a b] (-> (CoMonad w) (-> (w a) b) (w a) (w b))) (using w - (using _functor - (map f (split ma))))) + (map f (split ma)))) ## Syntax (defmacro #export (be tokens state) diff --git a/source/lux/control/monad.lux b/source/lux/control/monad.lux index a03c1499a..4e4786b63 100644 --- a/source/lux/control/monad.lux +++ b/source/lux/control/monad.lux @@ -82,7 +82,7 @@ (All [m a b] (-> (Monad m) (-> a (m b)) (m a) (m b))) (using m - (join (:: _functor (F;map f ma))))) + (join (map f ma)))) (def #export (map% m f xs) (All [m a b] diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux index f840688fd..1b1711ca7 100644 --- a/source/lux/data/list.lux +++ b/source/lux/data/list.lux @@ -13,7 +13,7 @@ (eq #as E) (dict #as D #refer #all) (stack #as S)) - (data (number (int #open ("i" Int/Number Int/Ord Int/Eq))) + (data (number (int #open ("i" Int/Number Int/Ord))) bool) meta/macro)) diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux index 1d582c1d5..d0a6c46d1 100644 --- a/source/lux/data/text.lux +++ b/source/lux/data/text.lux @@ -13,7 +13,7 @@ (ord #as O) (show #as S) (monad #as M #refer #all)) - (data (number (int #open ("i" Int/Number Int/Ord Int/Eq))) + (data (number (int #open ("i" Int/Number Int/Ord))) maybe (list #refer (#only foldL list list&))))) diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux index cdbade999..e1d821ff0 100644 --- a/source/lux/meta/lux.lux +++ b/source/lux/meta/lux.lux @@ -213,14 +213,14 @@ (case (get module (get@ #;modules state)) (#;Some =module) (using List/Monad - (#;Right [state (join (:: _functor (F;map (: (-> (, Text (, Bool (DefData' Macro))) - (List Text)) - (lambda [gdef] - (let [[name [export? _]] gdef] - (if export? - (list name) - (list))))) - (get@ #;defs =module))))])) + (#;Right [state (join (map (: (-> (, Text (, Bool (DefData' Macro))) + (List Text)) + (lambda [gdef] + (let [[name [export? _]] gdef] + (if export? + (list name) + (list))))) + (get@ #;defs =module)))])) #;None (#;Left ($ text:++ "Unknown module: " module)))) |