From e7fc42bbc7d0b56384864a6fcd1b1e0bf8cd880b Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 11 Jul 2018 07:36:33 -0400
Subject: - Improvements to import syntax [part 1].
---
stdlib/source/lux.lux | 65 ++++++++++++++++++++++++---------------------------
1 file changed, 30 insertions(+), 35 deletions(-)
(limited to 'stdlib/source/lux.lux')
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 4710b022b..6d1f9e106 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -4055,7 +4055,7 @@
#Nothing)
(type: Openings
- [Text (List Ident)])
+ [Text (List Text)])
(type: Refer
{#refer-defs Referrals
@@ -4115,17 +4115,20 @@
(def: (parse-short-referrals tokens)
(-> (List Code) (Meta [Referrals (List Code)]))
(case tokens
- (^ (list& [_ (#Form (list& [_ (#Tag "" "+")] defs))] tokens'))
+ (^or (^ (list& [_ (#Form (list& [_ (#Tag ["" "+"])] defs))] tokens'))
+ (^ (list& [_ (#Form (list& [_ (#Tag ["" "only"])] defs))] tokens')))
(do Monad
[defs' (extract-defs defs)]
(return [(#Only defs') tokens']))
- (^ (list& [_ (#Form (list& [_ (#Tag "" "-")] defs))] tokens'))
+ (^or (^ (list& [_ (#Form (list& [_ (#Tag ["" "-"])] defs))] tokens'))
+ (^ (list& [_ (#Form (list& [_ (#Tag ["" "exclude"])] defs))] tokens')))
(do Monad
[defs' (extract-defs defs)]
(return [(#Exclude defs') tokens']))
- (^ (list& [_ (#Tag "" "*")] tokens'))
+ (^or (^ (list& [_ (#Tag ["" "*"])] tokens'))
+ (^ (list& [_ (#Tag ["" "all"])] tokens')))
(return [#All tokens'])
_
@@ -4160,7 +4163,7 @@
[_ (#Text prefix)]
(list& [prefix (list)] openings)
- [_ (#Symbol struct-name)]
+ [_ (#Symbol ["" struct-name])]
(case openings
#Nil
(list ["" (list struct-name)])
@@ -4180,36 +4183,28 @@
(def: (parse-short-openings parts)
(-> (List Code) (Meta [(List Openings) (List Code)]))
- (if (|> parts
- (list/map (: (-> Code Bool)
- (function (_ part)
- (case part
- (^or [_ (#Text _)] [_ (#Symbol _)])
- true
+ (case parts
+ #.Nil
+ (return [#.Nil #.Nil])
- _
- 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'))
+ (^ (list& [_ (#Form (list& [_ (#Text prefix)] structs))] parts'))
+ (do Monad
+ [structs' (monad/map Monad
+ (function (_ struct)
+ (case struct
+ [_ (#Symbol ["" struct-name])]
+ (return struct-name)
- _
- openings)))
- (: (List Openings) (list))
- parts)]
- (return [openings (list)]))
- (fail "Expected all parts of opening form to be of either prefix (text) or struct (symbol).")))
+ _
+ (fail "Expected all structures of opening form to be symbols.")))
+ structs)
+ next+remainder (parse-short-openings parts')]
+ (let [[next remainder] next+remainder]
+ (return [(#.Cons [prefix structs'] next)
+ remainder])))
+
+ _
+ (return [#.Nil parts])))
(def: (decorate-sub-importations super-name)
(-> Text (List Importation) (List Importation))
@@ -4877,7 +4872,7 @@
defs')
openings (join-map (: (-> Openings (List Code))
(function (_ [prefix structs])
- (list/map (function (_ [_ name])
+ (list/map (function (_ name)
(` (open: (~ (text$ prefix)) (~ (symbol$ [module-name name])))))
structs)))
r-opens)]]
@@ -4912,7 +4907,7 @@
#Nothing
(list)))
=opens (join-map (function (_ [prefix structs])
- (list& (text$ prefix) (list/map symbol$ structs)))
+ (list& (text$ prefix) (list/map (|>> [""] symbol$) structs)))
r-opens)]
(` (..refer (~ (text$ module-name))
(~+ =defs)
--
cgit v1.2.3