aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux42
-rw-r--r--stdlib/source/lux/macro.lux9
-rw-r--r--stdlib/source/lux/tool/compiler/default/syntax.lux44
-rw-r--r--stdlib/source/lux/tool/compiler/phase/analysis/module.lux16
4 files changed, 55 insertions, 56 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 549d63112..323615249 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -5356,37 +5356,31 @@
(-> Type Code)
(case type
(#Primitive name params)
- (` (#Primitive (~ (text$ name)) (~ (untemplate-list (list;map type-to-code params)))))
+ (` (#.Primitive (~ (text$ name)) (~ (untemplate-list (list;map type-to-code params)))))
(^template [<tag>]
(<tag> left right)
(` (<tag> (~ (type-to-code left)) (~ (type-to-code right)))))
- ([#Sum] [#Product])
-
- (#Function in out)
- (` (#Function (~ (type-to-code in)) (~ (type-to-code out))))
-
- (#Parameter idx)
- (` (#Parameter (~ (nat$ idx))))
-
- (#Var id)
- (` (#Var (~ (nat$ id))))
+ ([#.Sum] [#.Product]
+ [#.Function]
+ [#.Apply])
- (#Ex id)
- (` (#Ex (~ (nat$ id))))
-
- (#UnivQ env type)
- (let [env' (untemplate-list (list;map type-to-code env))]
- (` (#UnivQ (~ env') (~ (type-to-code type)))))
+ (^template [<tag>]
+ (<tag> id)
+ (` (<tag> (~ (nat$ id)))))
+ ([#.Parameter] [#.Var] [#.Ex])
- (#ExQ env type)
- (let [env' (untemplate-list (list;map type-to-code env))]
- (` (#ExQ (~ env') (~ (type-to-code type)))))
+ (^template [<tag>]
+ (<tag> env type)
+ (let [env' (untemplate-list (list;map type-to-code env))]
+ (` (<tag> (~ env') (~ (type-to-code type))))))
+ ([#.UnivQ] [#.ExQ])
- (#Apply arg fun)
- (` (#Apply (~ (type-to-code arg)) (~ (type-to-code fun))))
-
- (#Named [module name] type)
+ (#Named [module name] anonymous)
+ ## TODO: Generate the explicit type definition instead of using
+ ## the "identifier$" shortcut below.
+ ## (` (#.Named [(~ (text$ module)) (~ (text$ name))]
+ ## (~ (type-to-code anonymous))))
(identifier$ [module name])))
(macro: #export (loop tokens)
diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux
index 2a9c55488..e44efeb6c 100644
--- a/stdlib/source/lux/macro.lux
+++ b/stdlib/source/lux/macro.lux
@@ -511,19 +511,20 @@
(#error.Success [compiler definition])
_
- (let [current-module (|> compiler (get@ #.current-module) (maybe.default "???"))]
+ (let [current-module (|> compiler (get@ #.current-module) (maybe.default "???"))
+ separator ($_ text;compose text.new-line " ")]
(#error.Failure ($_ text;compose
"Unknown definition: " (name;encode name) text.new-line
" Current module: " current-module text.new-line
(case (get current-module (get@ #.modules compiler))
(#.Some this-module)
($_ text;compose
- " Imports: " (|> this-module (get@ #.imports) (text.join-with ", ")) text.new-line
- " Aliases: " (|> this-module (get@ #.module-aliases) (list;map (function (_ [alias real]) ($_ text;compose alias " => " real))) (text.join-with ", ")) text.new-line)
+ " Imports: " (|> this-module (get@ #.imports) (text.join-with separator)) text.new-line
+ " Aliases: " (|> this-module (get@ #.module-aliases) (list;map (function (_ [alias real]) ($_ text;compose alias " => " real))) (text.join-with separator)) text.new-line)
_
"")
- " All Known modules: " (|> compiler (get@ #.modules) (list;map product.left) (text.join-with ", ")) text.new-line)))))))
+ " All Known modules: " (|> compiler (get@ #.modules) (list;map product.left) (text.join-with separator)) text.new-line)))))))
(def: #export (find-def-type name)
{#.doc "Looks-up a definition's type in the available modules (including the current one)."}
diff --git a/stdlib/source/lux/tool/compiler/default/syntax.lux b/stdlib/source/lux/tool/compiler/default/syntax.lux
index 4743d26ce..8eaf3a558 100644
--- a/stdlib/source/lux/tool/compiler/default/syntax.lux
+++ b/stdlib/source/lux/tool/compiler/default/syntax.lux
@@ -180,8 +180,8 @@
## else
<cannot-close>))))))))
-(`` (do-template [<name> <close> <tag> <context>]
- [(def: (<name> parse source)
+(do-template [<name> <close> <tag> <context>]
+ [(`` (def: (<name> parse source)
(-> Parser Parser)
(let [[_ _ source-code] source
source-code//size ("lux text size" source-code)]
@@ -193,20 +193,20 @@
(#error.Failure error)
(let [[where offset _] source]
- (case (read-close (char <close>) source-code//size source-code offset)
+ (case (read-close (char (~~ (static <close>))) source-code//size source-code offset)
(#error.Success offset')
(#error.Success [[(update@ #.column inc where) offset' source-code]
[where (<tag> (list.reverse stack))]])
(#error.Failure error)
- (#error.Failure error)))))))]
+ (#error.Failure error))))))))]
- ## Form and tuple syntax is mostly the same, differing only in the
- ## delimiters involved.
- ## They may have an arbitrary number of arbitrary Code nodes as elements.
- [parse-form (~~ (static ..close-form)) #.Form "Form"]
- [parse-tuple (~~ (static ..close-tuple)) #.Tuple "Tuple"]
- ))
+ ## Form and tuple syntax is mostly the same, differing only in the
+ ## delimiters involved.
+ ## They may have an arbitrary number of arbitrary Code nodes as elements.
+ [parse-form ..close-form #.Form "Form"]
+ [parse-tuple ..close-tuple #.Tuple "Tuple"]
+ )
(def: (parse-record parse source)
(-> Parser Parser)
@@ -500,27 +500,27 @@
(let [offset/1 (!inc offset/0)]
(<| (!with-char+ source-code//size source-code offset/1 char/1 <end-of-file>)
("lux syntax char case!" char/1
- [(~~ (do-template [<char> <bit>]
- [[<char>]
- (#error.Success [[(update@ #.column (|>> !inc/2) where)
- (!inc offset/1)
- source-code]
- [where (#.Bit <bit>)]])]
-
- ["0" #0]
- ["1" #1]))
+ [[(~~ (static ..name-separator))]
+ (!parse-short-name current-module <consume-2> where #.Tag)
## Single-line comment
[(~~ (static ..sigil))]
- (case ("lux text index" source-code (static text.new-line) offset/1)
+ (case ("lux text index" source-code (static text.new-line) (!inc offset/1))
(#.Some end)
(recur [(!new-line where) (!inc end) source-code])
_
<end-of-file>)
- [(~~ (static ..name-separator))]
- (!parse-short-name current-module <consume-2> where #.Tag)]
+ (~~ (do-template [<char> <bit>]
+ [[<char>]
+ (#error.Success [[(update@ #.column (|>> !inc/2) where)
+ (!inc offset/1)
+ source-code]
+ [where (#.Bit <bit>)]])]
+
+ ["0" #0]
+ ["1" #1]))]
## else
(cond (!name-char?|head char/1) ## Tag
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/module.lux b/stdlib/source/lux/tool/compiler/phase/analysis/module.lux
index cc7c857a0..0d69f524c 100644
--- a/stdlib/source/lux/tool/compiler/phase/analysis/module.lux
+++ b/stdlib/source/lux/tool/compiler/phase/analysis/module.lux
@@ -5,11 +5,11 @@
["ex" exception (#+ exception:)]
pipe]
[data
- ["." text ("#;." equivalence)
+ ["." text ("#@." equivalence)
format]
["." error]
[collection
- ["." list ("#;." fold functor)]
+ ["." list ("#@." fold functor)]
[dictionary
["." plist]]]]
["." macro]]
@@ -86,7 +86,11 @@
[self-name macro.current-module-name]
(function (_ state)
(#error.Success [(update@ #.modules
- (plist.update self-name (update@ #.imports (|>> (#.Cons module))))
+ (plist.update self-name (update@ #.imports (function (_ current)
+ (if (list.any? (text@= module)
+ current)
+ current
+ (#.Cons module current)))))
state)
[]])))))
@@ -236,16 +240,16 @@
(///.throw cannot-declare-tags-for-unnamed-type [tags type]))
_ (ensure-undeclared-tags self-name tags)
_ (///.assert cannot-declare-tags-for-foreign-type [tags type]
- (text;= self-name type-module))]
+ (text@= self-name type-module))]
(///extension.lift
(function (_ state)
(case (|> state (get@ #.modules) (plist.get self-name))
(#.Some module)
- (let [namespaced-tags (list;map (|>> [self-name]) tags)]
+ (let [namespaced-tags (list@map (|>> [self-name]) tags)]
(#error.Success [(update@ #.modules
(plist.update self-name
(|>> (update@ #.tags (function (_ tag-bindings)
- (list;fold (function (_ [idx tag] table)
+ (list@fold (function (_ [idx tag] table)
(plist.put tag [idx namespaced-tags exported? type] table))
tag-bindings
(list.enumerate tags))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-24 03:32:50 +0000