aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2015-08-04 00:22:28 -0400
committerEduardo Julian2015-08-04 00:22:28 -0400
commit8a78830404234dc6e766ed6b653905bd7c89fac2 (patch)
tree763eda8f7ab41dd3564e9d3251708aad697cfffc
parentddc471806fba8fe179d52b4781f0a66d871b5e99 (diff)
- Added a macro for exporting definitions (to not depend on the #export tag on definitions).
- The "open" and "using" macros now work recursively on records.
-rw-r--r--source/lux.lux54
-rw-r--r--source/lux/control/comonad.lux3
-rw-r--r--source/lux/control/monad.lux2
-rw-r--r--source/lux/data/list.lux2
-rw-r--r--source/lux/data/text.lux2
-rw-r--r--source/lux/meta/lux.lux16
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))))