From fdfd7036806fe62ffaf054b61fbf16bbfb002b7c Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 11 Jul 2018 19:47:40 -0400
Subject: - Improvements to import syntax [part 2].
---
stdlib/source/lux.lux | 198 +++++++++++++++-----------------------------------
1 file changed, 60 insertions(+), 138 deletions(-)
(limited to 'stdlib/source/lux.lux')
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 6d1f9e106..6e9604376 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -431,6 +431,11 @@
([_ ident] (_ann (#Symbol ident))))
[dummy-cursor (#Record #Nil)])
+("lux def" local-symbol$
+ ("lux check" (#Function Text Code)
+ ([_ ident] (_ann (#Symbol ["" ident]))))
+ [dummy-cursor (#Record #Nil)])
+
("lux def" tag$
("lux check" (#Function Ident Code)
([_ ident] (_ann (#Tag ident))))
@@ -4079,39 +4084,6 @@
(fail "only/exclude requires symbols."))))
defs))
-(def: (parse-alias tokens)
- (-> (List Code) (Meta [(Maybe Text) (List Code)]))
- (case tokens
- (^ (list& [_ (#Tag "" "as")] [_ (#Symbol "" alias)] tokens'))
- (return [(#Some alias) tokens'])
-
- _
- (return [#None tokens])))
-
-(def: (parse-referrals tokens)
- (-> (List Code) (Meta [Referrals (List Code)]))
- (case tokens
- (^ (list& [_ (#Tag ["" "refer"])] referral tokens'))
- (case referral
- [_ (#Tag "" "all")]
- (return [#All tokens'])
-
- (^ [_ (#Form (list& [_ (#Tag ["" "only"])] defs))])
- (do Monad
- [defs' (extract-defs defs)]
- (return [(#Only defs') tokens']))
-
- (^ [_ (#Form (list& [_ (#Tag ["" "exclude"])] defs))])
- (do Monad
- [defs' (extract-defs defs)]
- (return [(#Exclude defs') tokens']))
-
- _
- (fail "Incorrect syntax for referral."))
-
- _
- (return [#Nothing tokens])))
-
(def: (parse-short-referrals tokens)
(-> (List Code) (Meta [Referrals (List Code)]))
(case tokens
@@ -4134,53 +4106,6 @@
_
(return [#Nothing tokens])))
-(def: (extract-symbol syntax)
- (-> Code (Meta Ident))
- (case syntax
- [_ (#Symbol ident)]
- (return ident)
-
- _
- (fail "Not a symbol.")))
-
-(def: (parse-openings tokens)
- (-> (List Code) (Meta [(List Openings) (List Code)]))
- (case tokens
- (^ (list& [_ (#Tag "" "open")] [_ (#Form parts)] tokens'))
- (if (|> parts
- (list/map (: (-> Code Bool)
- (function (_ part)
- (case part
- (^or [_ (#Text _)] [_ (#Symbol _)])
- true
-
- _
- false))))
- (list/fold (function (_ r l) (and l r)) true))
- (let [openings (list/fold (: (-> Code (List Openings) (List Openings))
- (function (_ part openings)
- (case part
- [_ (#Text prefix)]
- (list& [prefix (list)] openings)
-
- [_ (#Symbol ["" struct-name])]
- (case openings
- #Nil
- (list ["" (list struct-name)])
-
- (#Cons [prefix structs] openings')
- (#Cons [prefix (#Cons struct-name structs)] openings'))
-
- _
- openings)))
- (: (List Openings) (list))
- parts)]
- (return [openings tokens']))
- (fail "Expected all parts of opening form to be of either prefix (text) or struct (symbol)."))
-
- _
- (return [(list) tokens])))
-
(def: (parse-short-openings parts)
(-> (List Code) (Meta [(List Openings) (List Code)]))
(case parts
@@ -4275,54 +4200,53 @@
(: (-> Code (Meta (List Importation)))
(function (_ token)
(case token
- [_ (#Symbol "" m-name)]
+ [_ (#Symbol ["" m-name])]
(do Monad
[m-name (clean-module relative-root m-name)]
- (wrap (list [m-name #None {#refer-defs #All
- #refer-open (list)}])))
+ (wrap (list {#import-name m-name
+ #import-alias #None
+ #import-refer {#refer-defs #All
+ #refer-open (list)}})))
- (^ [_ (#Form (list& [_ (#Symbol "" m-name)] extra))])
+ (^ [_ (#Tuple (list [_ (#Symbol ["" m-name])]))])
(do Monad
- [m-name (clean-module relative-root m-name)
- alias+extra (parse-alias extra)
- #let [[alias extra] alias+extra]
- referral+extra (parse-referrals extra)
- #let [[referral extra] referral+extra]
- openings+extra (parse-openings extra)
- #let [[openings extra] openings+extra]
- sub-imports (parse-imports relative-root extra)
- #let [sub-imports (decorate-sub-importations m-name sub-imports)]]
- (wrap (case [referral alias openings]
- [#Nothing #None #Nil] sub-imports
- _ (list& {#import-name m-name
- #import-alias alias
- #import-refer {#refer-defs referral
- #refer-open openings}}
- sub-imports))))
-
- (^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Symbol "" m-name)] extra))])
+ [import-name (clean-module relative-root m-name)]
+ (wrap (list {#import-name import-name
+ #import-alias (#Some m-name)
+ #import-refer {#refer-defs #Nothing
+ #refer-open (list)}})))
+
+ (^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Symbol ["" m-name])] extra))])
(do Monad
- [m-name (clean-module relative-root m-name)
+ [import-name (clean-module relative-root m-name)
referral+extra (parse-short-referrals extra)
#let [[referral extra] referral+extra]
openings+extra (parse-short-openings extra)
- #let [[openings extra] openings+extra]]
- (wrap (list {#import-name m-name
- #import-alias (#Some (replace-all "." m-name alias))
- #import-refer {#refer-defs referral
- #refer-open openings}})))
-
- (^ [_ (#Tuple (list& [_ (#Symbol "" raw-m-name)] extra))])
+ #let [[openings extra] openings+extra]
+ sub-imports (parse-imports relative-root extra)
+ #let [sub-imports (decorate-sub-importations import-name sub-imports)]]
+ (wrap (list& {#import-name import-name
+ #import-alias (#Some (replace-all "." m-name alias))
+ #import-refer {#refer-defs referral
+ #refer-open openings}}
+ sub-imports)))
+
+ (^ [_ (#Tuple (list& [_ (#Symbol ["" m-name])] extra))])
(do Monad
- [m-name (clean-module relative-root raw-m-name)
+ [import-name (clean-module relative-root m-name)
referral+extra (parse-short-referrals extra)
#let [[referral extra] referral+extra]
openings+extra (parse-short-openings extra)
- #let [[openings extra] openings+extra]]
- (wrap (list {#import-name m-name
- #import-alias (#Some raw-m-name)
- #import-refer {#refer-defs referral
- #refer-open openings}})))
+ #let [[openings extra] openings+extra]
+ sub-imports (parse-imports relative-root extra)
+ #let [sub-imports (decorate-sub-importations import-name sub-imports)]]
+ (wrap (case [referral openings]
+ [#Nothing #Nil] sub-imports
+ _ (list& {#import-name import-name
+ #import-alias (#Some m-name)
+ #import-refer {#refer-defs referral
+ #refer-open openings}}
+ sub-imports))))
_
(do Monad
@@ -4804,9 +4728,9 @@
(def: (read-refer module-name options)
(-> Text (List Code) (Meta Refer))
(do Monad
- [referral+options (parse-referrals options)
+ [referral+options (parse-short-referrals options)
#let [[referral options] referral+options]
- openings+options (parse-openings options)
+ openings+options (parse-short-openings options)
#let [[openings options] openings+options]
current-module current-module-name
#let [test-referrals (: (-> Text (List Text) (List Text) (Meta (List Any)))
@@ -4891,27 +4815,25 @@
(def: (refer-to-code module-name [r-defs r-opens])
(-> Text Refer Code)
- (let [=defs (: (List Code)
- (case r-defs
- #All
- (list (' #refer) (' #all))
-
- (#Only defs)
- (list (' #refer) (`' (#only (~+ (list/map (|>> [""] symbol$)
- defs)))))
-
- (#Exclude defs)
- (list (' #refer) (`' (#exclude (~+ (list/map (|>> [""] symbol$)
- defs)))))
-
- #Nothing
- (list)))
- =opens (join-map (function (_ [prefix structs])
- (list& (text$ prefix) (list/map (|>> [""] symbol$) structs)))
- r-opens)]
+ (let [localizations (: (List Code)
+ (case r-defs
+ #All
+ (list (' #*))
+
+ (#Only defs)
+ (list (form$ (list& (' #+) (list/map local-symbol$ defs))))
+
+ (#Exclude defs)
+ (list (form$ (list& (' #-) (list/map local-symbol$ defs))))
+
+ #Nothing
+ (list)))
+ openings (list/map (function (_ [prefix structs])
+ (form$ (list& (text$ prefix) (list/map local-symbol$ structs))))
+ r-opens)]
(` (..refer (~ (text$ module-name))
- (~+ =defs)
- (~' #open) ((~+ =opens))))))
+ (~+ localizations)
+ (~+ openings)))))
(macro: #export (module: tokens)
{#.doc "Module-definition macro.
--
cgit v1.2.3