aboutsummaryrefslogtreecommitdiff
path: root/source/lux.lux
diff options
context:
space:
mode:
authorEduardo Julian2015-08-04 00:22:28 -0400
committerEduardo Julian2015-08-04 00:22:28 -0400
commit8a78830404234dc6e766ed6b653905bd7c89fac2 (patch)
tree763eda8f7ab41dd3564e9d3251708aad697cfffc /source/lux.lux
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.
Diffstat (limited to 'source/lux.lux')
-rw-r--r--source/lux.lux54
1 files changed, 35 insertions, 19 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)))