branch: elpa/loopy commit 30ca70a9d4bc4201c57bd6fbc87c14b1c0f416f7 Author: okamsn <28612288+oka...@users.noreply.github.com> Commit: GitHub <nore...@github.com>
Combine `loopy-command-parsers` and `loopy-aliases` into `loopy-parsers`. (#237) - Deprecate `loopy-command-parsers` and `loopy-aliases`. Both variables are now `nil`. - Add new customizable variable user option `loopy-parsers`, a hash table mapping symbols to parsing functions, including for special macro arguments. In the case of special macro arguments, the functions are fake, but the symbols are used to identify the SMAs, instead of knowing the SMAs and fetching the parsing functions. - Add verifier `loopy--expression-parser-map-p`. - Update `loopy-iter-overwritten-command-parsers` to refer to `loopy-parsers` instead of `loopy-command-parsers`. - Update `loopy-iter-overwritten-command-parsers` to mention loopy-parsers. - Update `loopy-defalias` to use `loopy-parsers`. Add internal function `loopy--defalias-1`, which the macro now wraps. - Add `loopy--parsers-internal` to `loopy--variables`. - Change the special macro processors (`loopy--def-special-processor`, `loopy-iter--def-special-processor`, `loopy--process-special-arg-loop-name`, and `loopy-iter--process-special-arg-loop-name`) to refer to `loopy-parsers` for whether a symbol is the name of a special macro argument, checking for symbols which are the names of fake functions. - Remove unused optional argument `ignored` from special processors for the `loopy` macro. This argument might still be used in `loopy-iter`. - Update `loopy--obsolete-aliases` to be a hash table of obsolete alias to original name. - Update `loopy--get-command-parser` to use `loopy-parsers`, removing extra arguments after the command name. Make this function refer to `loopy--obsolete-aliases` now that we no longer fetch aliases separately. - Remove variable `loopy-iter--command-parsers`, which was the alist of command parsers and over-written command parsers from `loopy-iter-overwritten-command-parsers`. Instead, write the overwritten parsers to `loopy--parsers-internal`, which we plan to use in local overrides. - Remove functions the rely on knowing "true names", such as via `loopy--get-true-name` - Delete `loopy--accumulation-constructors` by moving data inside the plist created by the parsing function. Update the function `loopy--expand-optimized-accum` to use this data. - Remove these functions: - `loopy--get-true-name` - `loopy--get-aliases` - `loopy--get-all-names` - `loopy--process-special-marco-args` (note the typo) - `my-iter-insert` - `loopy--find-special-macro-arguments` - Remove these variables: - `loopy--special-macro-arguments` - `loopy--special-maro-argument-processors` (note the typo) - Add tests - Add `my-ht-map-insert` because `map-insert` doesn't work with hash tables on Emacs 27. - Add notes in doc strings of some tests that they should be removed when `loopy-command-parsers` is removed: - accumulation-conflicting-final-updates - `custom-command-sum` - `custom-command-always-pass` - `custom-command-always-fail` - Replace them with these: - `custom-command-sum-ht` - `custom-command-always-pass-ht` - `custom-command-always-fail-ht` - Add test `custom-alias-obsolete-list-array` to make sure aliasing to the obsolete aliases still works, while we have them. - Update these tests to use `loopy-parsers` instead of `loopy-aliases`: - custom-alias-flag - custom-alias-with - custom-alias-without - Keep some commands referring to `loopy-command-parsers` and `loopy-aliases` for testing purposes, while they are not fully removed. - Update and correct Org doc. - Remove references to `loopy-command-parsers` and `loopy-aliases`. - Clarify that, implementation-wise, aliases are no different than preferred feature names. - In the section Custom Aliases: - In the table of example aliases in Custom Aliases, don't give `seqf` as an alias of `sequencef`, since it no longer is. Instead, give `number` as an alias of `numbers`. - In Custom Aliases, combine example of aliasing commands and special macro arguments. Update these commands to use `loopy-parsers`. - Warn that one should avoid globally overriding the existing names. - In the section Custom Commands, refer to `loopy-parsers` instead of `loopy-command-parsers` and `loopy-aliases`. Update examples. - For testing Emacs 27, define Lisp Data Mode, whose absence breaks installing Dash for Loopy Dash, for some reason. --- CHANGELOG.md | 22 ++ README.org | 3 + doc/loopy-doc.org | 148 ++++++------- doc/loopy.texi | 158 ++++++-------- lisp/loopy-commands.el | 82 ++++--- lisp/loopy-iter.el | 154 +++++++------ lisp/loopy-vars.el | 562 ++++++++++++++++++++++++++---------------------- lisp/loopy.el | 74 ++----- tests/install-script.el | 13 ++ tests/tests.el | 238 +++++++++++++++++--- 10 files changed, 815 insertions(+), 639 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2560894ace..af289e98cb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,7 +12,29 @@ For Loopy Dash, see <https://github.com/okamsn/loopy-dash>. binds `VAR` to `nil`, but since this form is indistinguishable from a mistake, and since `nil` is a short word to write, this behavior is deprecated. +- `loopy-command-parsers` and `loopy-aliases` are both deprecated in favor of + the newly added `loopy-parsers` ([#237]). The new user option simplifies the + code internally, making it easier to add local overrides in the future, which + will make code which custom commands more portable. + + The new user option is a hash table which maps symbols to parsing functions. + There is no longer a separate mapping of aliases to original names. However, + `loopy-defalias` will continue to work. + +### Internal Changes + +- As far as the implementation is concerned, "aliases" are no longer a separate + concept from commands ([#237]). Aliases and true command names now exist in a + single hash table, `loopy-parsers`, and are indistinguishable. This simplifies + the code and makes this part of the code slightly faster. + - Special macro arguments are now identified by the parsing function given in + `loopy-parsers`, even though the corresponding function doesn't actually + exist. + + [#229]: https://github.com/okamsn/loopy/PR/229 +[#237]: https://github.com/okamsn/loopy/PR/237 + ## 0.14.0 diff --git a/README.org b/README.org index 15536d3b16..8d30c35f78 100644 --- a/README.org +++ b/README.org @@ -38,6 +38,9 @@ please let me know. - Unreleased: - =set= now warns when it is not given a value. In the future, it will signal an error. + - ~loopy-command-parsers~ and ~loopy-aliases~ are deprecated in favor of + a single hash table in the new user option ~loopy-parsers~. This + simplified the code and will make adding local overrides easier. - Version 0.14.0: - Conflicting initialization values for accumulation variables now signal a warning. In the future, they will signal an error. diff --git a/doc/loopy-doc.org b/doc/loopy-doc.org index 6f16dc35f0..75066ddaf9 100644 --- a/doc/loopy-doc.org +++ b/doc/loopy-doc.org @@ -663,8 +663,13 @@ is assigned a value from the list after collecting =i= into =coll=. For convenience and understanding, the same command might have multiple names, called {{{dfn(aliases)}}}. For example, the =array= command has the alias =string=, because the =array= command can be used to iterate through the -elements of an array or string[fn:1]. You can define custom aliases using the -macro ~loopy-defalias~ ([[#custom-aliases][Custom Aliases]]). +elements of an array or string[fn:1]. Implementation-wise, there is no longer a +difference between a loop command's preferred name (which are the ones commonly +used and listed first in this document) and its aliases. We continue to use the +word "alias" for its common definition rather than to suggest a difference in +the code. Both preferred names and aliases are found in the customizable +variable ~loopy-parsers~. You can define custom aliases by modifying this +variable ([[#custom-aliases][Custom Aliases]]). Similar to other libraries, many commands have an alias of the present-participle form (the "-ing" form). A few examples are seen in the table @@ -4535,12 +4540,12 @@ arguments that are recognized by default are given in [[#iter-default-names]]. (at outer (collecting j)))) #+end_src -The command aliases recognized by ~loopy-iter~ can be customized with the user -option ~loopy-iter-bare-commands~, which is a list of symbols naming commands -and their aliases. Again, these commands are found in the loop body by using -Emacs Lisp's macro-expansion features, so adding an alias that overrides a -symbol's function definition can cause errors. ~loopy~, whose environment is -more limited, does not have this restriction. +The non-conflicting command aliases recognized by ~loopy-iter~ can be customized +with the user option ~loopy-iter-bare-commands~, which is a list of symbols +naming commands and their aliases. Again, these commands are found in the loop +body by using Emacs Lisp's macro-expansion features, so adding an alias that +overrides a symbol's function definition can cause errors. ~loopy~, whose +environment is more limited, does not have this restriction. #+vindex: loopy-iter-bare-special-macro-arguments The special macro arguments (and their aliases) recognized by ~loopy-iter~ can @@ -4568,7 +4573,7 @@ FUNC)~. For example, This method recognizes all commands and their aliases in the user option -~loopy-aliases~. +~loopy-parsers~. #+caption: The first example, but now using keyword symbols. #+begin_src emacs-lisp @@ -4926,19 +4931,24 @@ and produce inefficient code. :END: #+cindex: custom aliases -An {{{dfn(alias)}}} is another name for a command or special macro argument. -~loopy~ comes with several built-in aliases, such as =string= for the command -=array= or =else= for the special macro argument =after-do=. +An {{{dfn(alias)}}} is another name for a loop command ([[#loop-commands]]) or +special macro argument ([[#macro-arguments][Special Macro Arguments]]). ~loopy~ comes with several +built-in aliases, such as =string= for the command =array= or =else= for the +special macro argument =after-do=. | Command or Special Macro Argument | Built-In Aliases | |-----------------------------------+----------------------------| | =array= | =string= | -| =seq-ref= | =sequence-ref=, =seqf= | +| =numbers= | =number= | | =after-do= | =after=, =else=, =else-do= | -An alias works the same as the original command or special macro argument. -They are provided for clarity and convenience. +Using an alias works the same as using the preferred name of the command or +special macro argument. Implementation-wise, there is no longer a difference +between aliases and preferred names (which are the ones commonly used and listed +first in this document). We continue to use the word "alias" for its common +definition rather than to suggest a difference in the code. +#+caption: `array' and `string' are different names for the same command. #+begin_src emacs-lisp ;; => ("a" "b" "c" "d") (loopy (array i "abcd") @@ -4949,73 +4959,36 @@ They are provided for clarity and convenience. (collect (char-to-string i))) #+end_src -#+findex: loopy-defalias -Users can define custom aliases using the macro ~loopy-defalias~, which takes an -alias and a definition as arguments. These arguments can be quoted or unquoted. - -#+begin_src emacs-lisp - (loopy-defalias items array) - - ;; => (1 2 3) - (loopy (items i [1 2 3]) - (collect i)) -#+end_src - -The definition must exist for the alias to be defined correctly. Definitions -can themselves be aliases, so long as they are already defined. In other words, -when aliasing custom commands, you should define the alias /after/ defining the -command ([[#adding-custom-commands]]). - -#+begin_src emacs-lisp - ;; Define an alias for the `items' alias from above: - (loopy-defalias items2 items) - - ;; => (1 2 3) - (loopy (items2 i [1 2 3]) - (collect i)) -#+end_src - -When looking for how to parse a command, ~loopy~ will check aliases before -checking the true names of commands. Effectively, this means that commands can -be overridden by aliases, though this is discouraged. Such commands can still -be accessed via their other names. - -#+begin_src emacs-lisp - ;; Define `cons' as an alias of `array': - (loopy-defalias cons array) - - ;; => (1 2 3) - (loopy (cons i [1 2 3]) - (collect i)) - - ;; ERROR: Can no longer use the original definition: - (loopy (cons i '(1 2 3)) - (collect i)) - - ;; Other names still work: - ;; => ((1 2 3) (2 3) (3)) - (loopy (conses i '(1 2 3)) - (collect i)) -#+end_src - -Special macro arguments ([[#macro-arguments][Special Macro Arguments]]) can also be aliased. Using an -alias does not change the fact that the special macro arguments are parsed -before loop commands. +#+findex: aliases in loopy-parsers +Users can define a new name for a command or special macro argument by adding an +entry to the customizable variable ~loopy-parsers~ with the appropriate parsing +function. Using an alias does not change the fact that special macro arguments +are parsed before loop commands. #+begin_src emacs-lisp - (loopy-defalias as with) + (setf (map-elt loopy-parsers 'items) (map-elt loopy-parsers 'array) + (map-elt loopy-parsers 'as) (map-elt loopy-parsers 'with)) ;; => (8 9 10) - (loopy (as (a 7)) - (list i '(1 2 3)) - (collect (+ i 7))) + (loopy (as (seven 7)) + (items i [1 2 3]) + (collect (+ i seven))) #+end_src -#+vindex: loopy-aliases -The macro ~loopy-defalias~ modifies the user option ~loopy-aliases~. However, -while ~loopy~ is still changing, it is recommended to avoid modifying this -variable directly, as its structure may change in the future. ~loopy-defalias~ -is the forward-compatible way of creating aliases. +#+findex: loopy-defalias +Previously, the macro ~loopy-defalias~ was used to modify the now-deprecated +user option ~loopy-aliases~. Now, it modifies ~loopy-parsers~. This change +should be unnoticed by users. ~loopy-defalias~ remains a forward-compatible way +of creating aliases. + +#+attr_texinfo: :tag Warning +#+begin_quote +For portability reasons, you should not globally override any of the existing +names, as that might create conflicts during macro expansion with other code +that uses the macro and relies on those names. In the future, one will able to +add local command definitions that apply only to a single instance of the macro +during expansion. +#+end_quote * Custom Commands :PROPERTIES: @@ -5093,9 +5066,8 @@ because special macro arguments are always parsed before loop commands. Commands are parsed by ~loopy--parse-loop-command~, which receives a command call, such as =(list i '(1 2 3))=, and returns a list of instructions. It does this by searching for an appropriate command-specific parsing function in -~loopy-aliases~ and ultimately in ~loopy-command-parsers~. For parsing multiple -commands in order, there is ~loopy--parse-loop-commands~, which wraps the -single-command version. +~loopy-parsers~. For parsing multiple commands in order, there is +~loopy--parse-loop-commands~, which wraps the single-command version. For example, consider the function ~loopy--parse-if-command~, which parses the =if= loop command. It needs to check the instructions of the sub-commands @@ -5428,16 +5400,16 @@ main body, so the definition of the parsing function is quite simple. Loopy will pass the entire command expression to the parsing function, and expects that a list of instructions will be returned. -#+vindex: loopy-command-parsers +#+vindex: loopy-parsers To tell Loopy about this function, add it and the command name =greet= to the -variable ~loopy-command-parsers~, which associates commands with parsing +variable ~loopy-parsers~, which associates commands with parsing functions. The function that is paired with the symbol receives the entire command expression, and should produce a list of valid instructions. #+BEGIN_SRC emacs-lisp ;; Using the Map library, for convenience: (require 'map) - (setf (map-elt loopy-command-parsers 'greet) + (setf (map-elt loopy-parsers 'greet) #'my-loopy-greet-command-parser) #+END_SRC @@ -5581,7 +5553,7 @@ With that in mind, our instructions for the loop would be Once we've chosen our instructions, we need to tell Loopy what function to use to produce these instructions. Like in the previous example, we define the -parsing function and add it to ~loopy-command-parsers~. +parsing function and add it to ~loopy-parsers~. #+begin_src emacs-lisp ;; As noted in the previous section, the parsing function is always @@ -5614,14 +5586,14 @@ parsing function and add it to ~loopy-command-parsers~. (setq ,result-var nil) ,@main-exprs)))))))) - (setf (map-elt loopy-command-parsers 'always) + (setf (map-elt loopy-parsers 'always) #'my--loopy-always-command-parser) #+end_src -Once we've added our parsing function to ~loopy-command-parsers~, Loopy will use -that function whenever it tries to understand the =always= command. In this -case, this custom parser would supercede the built-in parser. An example output -of parsing an example command would be: +Once we've added our parsing function to ~loopy-parsers~, Loopy will use that +function whenever it tries to understand the =always= command. In this case, +this custom parser would supercede the built-in parser. An example output of +parsing an example command would be: #+begin_src emacs-lisp (my--loopy-always-command-parser '(always (< i 10))) diff --git a/doc/loopy.texi b/doc/loopy.texi index a1a5a0ee81..281c64f0c1 100644 --- a/doc/loopy.texi +++ b/doc/loopy.texi @@ -704,7 +704,7 @@ You should keep in mind that commands are evaluated in order. This means that attempting something like the below example might not do what you expect, as @samp{i} is assigned a value from the list after collecting @samp{i} into @samp{coll}. -@float Listing,org18d32d9 +@float Listing,org856c86a @lisp ;; => (nil 1 2) (loopy (collect coll i) @@ -718,8 +718,13 @@ For convenience and understanding, the same command might have multiple names, called @dfn{aliases}. For example, the @samp{array} command has the alias @samp{string}, because the @samp{array} command can be used to iterate through the elements of an array or string@footnote{Strings being a kind of array. See @ref{Sequences Arrays Vectors,,,elisp,} -for more.}. You can define custom aliases using the -macro @code{loopy-defalias} (@ref{Custom Aliases}). +for more.}. Implementation-wise, there is no longer a +difference between a loop command's preferred name (which are the ones commonly +used and listed first in this document) and its aliases. We continue to use the +word ``alias'' for its common definition rather than to suggest a difference in +the code. Both preferred names and aliases are found in the customizable +variable @code{loopy-parsers}. You can define custom aliases by modifying this +variable (@ref{Custom Aliases}). Similar to other libraries, many commands have an alias of the present-participle form (the ``-ing'' form). A few examples are seen in the table @@ -888,7 +893,7 @@ the flag @samp{dash} provided by the package @samp{loopy-dash}. Below are two examples of destructuring in @code{cl-loop} and @code{loopy}. -@float Listing,org4212921 +@float Listing,orgab44b24 @lisp ;; => (1 2 3 4) (cl-loop for (i . j) in '((1 . 2) (3 . 4)) @@ -903,7 +908,7 @@ Below are two examples of destructuring in @code{cl-loop} and @code{loopy}. @caption{Destructuring values in a list.} @end float -@float Listing,org8ea6554 +@float Listing,org51fdf8f @lisp ;; => (1 2 3 4) (cl-loop for elem in '((1 . 2) (3 . 4)) @@ -4891,12 +4896,12 @@ arguments that are recognized by default are given in @ref{Default Bare Names in (at outer (collecting j)))) @end lisp -The command aliases recognized by @code{loopy-iter} can be customized with the user -option @code{loopy-iter-bare-commands}, which is a list of symbols naming commands -and their aliases. Again, these commands are found in the loop body by using -Emacs Lisp's macro-expansion features, so adding an alias that overrides a -symbol's function definition can cause errors. @code{loopy}, whose environment is -more limited, does not have this restriction. +The non-conflicting command aliases recognized by @code{loopy-iter} can be customized +with the user option @code{loopy-iter-bare-commands}, which is a list of symbols +naming commands and their aliases. Again, these commands are found in the loop +body by using Emacs Lisp's macro-expansion features, so adding an alias that +overrides a symbol's function definition can cause errors. @code{loopy}, whose +environment is more limited, does not have this restriction. @vindex loopy-iter-bare-special-macro-arguments The special macro arguments (and their aliases) recognized by @code{loopy-iter} can @@ -4928,9 +4933,9 @@ using the @code{let*} special form. This method recognizes all commands and their aliases in the user option -@code{loopy-aliases}. +@code{loopy-parsers}. -@float Listing,orge784fba +@float Listing,org8bd5c99 @lisp ;; => ((-9 -8 -7 -6 -5 -4 -3 -2 -1) ;; (0) @@ -5431,24 +5436,29 @@ and produce inefficient code. @chapter Custom Aliases @cindex custom aliases -An @dfn{alias} is another name for a command or special macro argument. -@code{loopy} comes with several built-in aliases, such as @samp{string} for the command -@samp{array} or @samp{else} for the special macro argument @samp{after-do}. +An @dfn{alias} is another name for a loop command (@ref{Loop Commands}) or +special macro argument (@ref{Special Macro Arguments}). @code{loopy} comes with several +built-in aliases, such as @samp{string} for the command @samp{array} or @samp{else} for the +special macro argument @samp{after-do}. @multitable {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaa} @headitem Command or Special Macro Argument @tab Built-In Aliases @item @samp{array} @tab @samp{string} -@item @samp{seq-ref} -@tab @samp{sequence-ref}, @samp{seqf} +@item @samp{numbers} +@tab @samp{number} @item @samp{after-do} @tab @samp{after}, @samp{else}, @samp{else-do} @end multitable -An alias works the same as the original command or special macro argument. -They are provided for clarity and convenience. +Using an alias works the same as using the preferred name of the command or +special macro argument. Implementation-wise, there is no longer a difference +between aliases and preferred names (which are the ones commonly used and listed +first in this document). We continue to use the word ``alias'' for its common +definition rather than to suggest a difference in the code. +@float Listing,orgd9e70b9 @lisp ;; => ("a" "b" "c" "d") (loopy (array i "abcd") @@ -5458,74 +5468,39 @@ They are provided for clarity and convenience. (loopy (string i "abcd") (collect (char-to-string i))) @end lisp +@caption{`array' and `string' are different names for the same command.} +@end float -@findex loopy-defalias -Users can define custom aliases using the macro @code{loopy-defalias}, which takes an -alias and a definition as arguments. These arguments can be quoted or unquoted. - -@lisp -(loopy-defalias items array) - -;; => (1 2 3) -(loopy (items i [1 2 3]) - (collect i)) -@end lisp - -The definition must exist for the alias to be defined correctly. Definitions -can themselves be aliases, so long as they are already defined. In other words, -when aliasing custom commands, you should define the alias @emph{after} defining the -command (@ref{Custom Commands}). - -@lisp -;; Define an alias for the `items' alias from above: -(loopy-defalias items2 items) - -;; => (1 2 3) -(loopy (items2 i [1 2 3]) - (collect i)) -@end lisp - -When looking for how to parse a command, @code{loopy} will check aliases before -checking the true names of commands. Effectively, this means that commands can -be overridden by aliases, though this is discouraged. Such commands can still -be accessed via their other names. +@findex aliases in loopy-parsers +Users can define a new name for a command or special macro argument by adding an +entry to the customizable variable @code{loopy-parsers} with the appropriate parsing +function. Using an alias does not change the fact that special macro arguments +are parsed before loop commands. @lisp -;; Define `cons' as an alias of `array': -(loopy-defalias cons array) +(setf (map-elt loopy-parsers 'items) (map-elt loopy-parsers 'array) + (map-elt loopy-parsers 'as) (map-elt loopy-parsers 'with)) -;; => (1 2 3) -(loopy (cons i [1 2 3]) - (collect i)) - -;; ERROR: Can no longer use the original definition: -(loopy (cons i '(1 2 3)) - (collect i)) - -;; Other names still work: -;; => ((1 2 3) (2 3) (3)) -(loopy (conses i '(1 2 3)) - (collect i)) +;; => (8 9 10) +(loopy (as (seven 7)) + (items i [1 2 3]) + (collect (+ i seven))) @end lisp -Special macro arguments (@ref{Special Macro Arguments}) can also be aliased. Using an -alias does not change the fact that the special macro arguments are parsed -before loop commands. - -@lisp -(loopy-defalias as with) +@findex loopy-defalias +Previously, the macro @code{loopy-defalias} was used to modify the now-deprecated +user option @code{loopy-aliases}. Now, it modifies @code{loopy-parsers}. This change +should be unnoticed by users. @code{loopy-defalias} remains a forward-compatible way +of creating aliases. -;; => (8 9 10) -(loopy (as (a 7)) - (list i '(1 2 3)) - (collect (+ i 7))) -@end lisp +@quotation Warning +For portability reasons, you should not globally override any of the existing +names, as that might create conflicts during macro expansion with other code +that uses the macro and relies on those names. In the future, one will able to +add local command definitions that apply only to a single instance of the macro +during expansion. -@vindex loopy-aliases -The macro @code{loopy-defalias} modifies the user option @code{loopy-aliases}. However, -while @code{loopy} is still changing, it is recommended to avoid modifying this -variable directly, as its structure may change in the future. @code{loopy-defalias} -is the forward-compatible way of creating aliases. +@end quotation @node Custom Commands @chapter Custom Commands @@ -5619,9 +5594,8 @@ because special macro arguments are always parsed before loop commands. Commands are parsed by @code{loopy--parse-loop-command}, which receives a command call, such as @samp{(list i '(1 2 3))}, and returns a list of instructions. It does this by searching for an appropriate command-specific parsing function in -@code{loopy-aliases} and ultimately in @code{loopy-command-parsers}. For parsing multiple -commands in order, there is @code{loopy--parse-loop-commands}, which wraps the -single-command version. +@code{loopy-parsers}. For parsing multiple commands in order, there is +@code{loopy--parse-loop-commands}, which wraps the single-command version. For example, consider the function @code{loopy--parse-if-command}, which parses the @samp{if} loop command. It needs to check the instructions of the sub-commands @@ -6010,16 +5984,16 @@ main body, so the definition of the parsing function is quite simple. Loopy will pass the entire command expression to the parsing function, and expects that a list of instructions will be returned. -@vindex loopy-command-parsers +@vindex loopy-parsers To tell Loopy about this function, add it and the command name @samp{greet} to the -variable @code{loopy-command-parsers}, which associates commands with parsing +variable @code{loopy-parsers}, which associates commands with parsing functions. The function that is paired with the symbol receives the entire command expression, and should produce a list of valid instructions. @lisp ;; Using the Map library, for convenience: (require 'map) -(setf (map-elt loopy-command-parsers 'greet) +(setf (map-elt loopy-parsers 'greet) #'my-loopy-greet-command-parser) @end lisp @@ -6173,7 +6147,7 @@ With that in mind, our instructions for the loop would be Once we've chosen our instructions, we need to tell Loopy what function to use to produce these instructions. Like in the previous example, we define the -parsing function and add it to @code{loopy-command-parsers}. +parsing function and add it to @code{loopy-parsers}. @lisp ;; As noted in the previous section, the parsing function is always @@ -6206,14 +6180,14 @@ Otherwise, `loopy' should return t." (setq ,result-var nil) ,@@main-exprs)))))))) -(setf (map-elt loopy-command-parsers 'always) +(setf (map-elt loopy-parsers 'always) #'my--loopy-always-command-parser) @end lisp -Once we've added our parsing function to @code{loopy-command-parsers}, Loopy will use -that function whenever it tries to understand the @samp{always} command. In this -case, this custom parser would supercede the built-in parser. An example output -of parsing an example command would be: +Once we've added our parsing function to @code{loopy-parsers}, Loopy will use that +function whenever it tries to understand the @samp{always} command. In this case, +this custom parser would supercede the built-in parser. An example output of +parsing an example command would be: @lisp (my--loopy-always-command-parser '(always (< i 10))) diff --git a/lisp/loopy-commands.el b/lisp/loopy-commands.el index ba60d919ee..b1919d28a3 100644 --- a/lisp/loopy-commands.el +++ b/lisp/loopy-commands.el @@ -1778,16 +1778,15 @@ Then entire plist is passed to the constructor found in second pass of macro expansion." ;; Data is quoted to prevent recursive macro expansion. (let ((plist (cl-second arg))) - (loopy--plist-bind (:name name :loop loop) + (loopy--plist-bind (:name name :loop loop :opt-accum-fn fn) plist - (let ((true-name (loopy--get-true-name name))) - (if-let ((func (map-elt loopy--accumulation-constructors true-name))) - (cl-destructuring-bind (main-body other-instrs) - (loopy--extract-main-body (funcall func plist)) - (loopy--process-instructions - `((loopy--at-instructions (,loop ,@(remq nil other-instrs))))) - (macroexp-progn main-body)) - (signal 'loopy-accum-constructor-missing (list name))))))) + (if (null fn) + (signal 'loopy-accum-constructor-missing (list name plist)) + (cl-destructuring-bind (main-body other-instrs) + (loopy--extract-main-body (funcall fn plist)) + (loopy--process-instructions + `((loopy--at-instructions (,loop ,@(remq nil other-instrs))))) + (macroexp-progn main-body)))))) (cl-defun loopy--update-accum-place-count (loop var place &optional (value 1)) "Keep track of where things are being placed. @@ -2049,7 +2048,8 @@ you can use in the instructions: `((loopy--main-body (loopy--optimized-accum '( :cmd ,cmd :name ,name :var ,var :val ,val - :test ,test :key ,key :at ,pos))))) + :test ,test :key ,key :at ,pos + :opt-accum-fn loopy--construct-accum-adjoin))))) (loopy--check-accumulation-compatibility loopy--loop-name var 'list cmd) `((loopy--accumulation-vars (,var nil)) @@ -2079,7 +2079,8 @@ you can use in the instructions: `((loopy--main-body (loopy--optimized-accum '( :cmd ,cmd :name ,name :var ,var :val ,val - :test ,test :key ,key :at ,pos))) + :test ,test :key ,key :at ,pos + :opt-accum-fn loopy--construct-accum-adjoin))) (loopy--implicit-return ,var)))) ;;;;;;; Append @@ -2130,7 +2131,8 @@ you can use in the instructions: (loopy--main-body (loopy--optimized-accum '( :loop ,loopy--loop-name :var ,var :val ,val - :cmd ,cmd :name ,name :at ,pos))))) + :cmd ,cmd :name ,name :at ,pos + :opt-accum-fn loopy--construct-accum-append))))) (loopy--check-accumulation-compatibility loopy--loop-name var 'list cmd) `((loopy--accumulation-vars (,var nil)) ,@(cond @@ -2155,7 +2157,8 @@ you can use in the instructions: `((loopy--accumulation-vars (,var nil)) (loopy--main-body (loopy--optimized-accum '( :loop ,loopy--loop-name :var ,var :val ,val - :cmd ,cmd :name ,name :at ,pos))) + :cmd ,cmd :name ,name :at ,pos + :opt-accum-fn loopy--construct-accum-append))) (loopy--implicit-return ,var)))) ;;;;;;; Collect @@ -2200,7 +2203,8 @@ you can use in the instructions: `((loopy--main-body (loopy--optimized-accum '( :loop ,loopy--loop-name :var ,var :val ,val - :cmd ,cmd :name ,name :at ,pos))))) + :cmd ,cmd :name ,name :at ,pos + :opt-accum-fn loopy--construct-accum-collect))))) (loopy--check-accumulation-compatibility loopy--loop-name var 'list cmd) `((loopy--accumulation-vars (,var nil)) @@ -2223,7 +2227,8 @@ you can use in the instructions: `((loopy--main-body (loopy--optimized-accum '( :loop ,loopy--loop-name :var ,var :val ,val - :cmd ,cmd :name ,name :at ,pos))) + :cmd ,cmd :name ,name :at ,pos + :opt-accum-fn loopy--construct-accum-collect))) (loopy--implicit-return ,var)))) ;;;;;;; Concat @@ -2266,7 +2271,8 @@ This function is called by `loopy--expand-optimized-accum'." (loopy--main-body (loopy--optimized-accum '( :loop ,loopy--loop-name :var ,var :val ,val - :cmd ,cmd :name ,name :at ,pos))) + :cmd ,cmd :name ,name :at ,pos + :opt-accum-fn loopy--construct-accum-concat))) (loopy--implicit-return ,var))) (loopy--check-accumulation-compatibility loopy--loop-name var 'string cmd) @@ -2292,7 +2298,8 @@ This function is called by `loopy--expand-optimized-accum'." (loopy--main-body (loopy--optimized-accum '( :loop ,loopy--loop-name :var ,var :val ,val - :cmd ,cmd :name ,name :at ,pos))) + :cmd ,cmd :name ,name :at ,pos + :opt-accum-fn loopy--construct-accum-concat))) (loopy--implicit-return ,var)))) ;;;;;;; Count @@ -2469,7 +2476,8 @@ EXPR is the value to bind to VAR." `((loopy--accumulation-vars (,var nil)) (loopy--main-body (loopy--optimized-accum '( :loop ,loopy--loop-name :var ,var - :val ,val :cmd ,cmd :name ,name :at ,pos))))) + :val ,val :cmd ,cmd :name ,name :at ,pos + :opt-accum-fn loopy--construct-accum-nconc))))) (loopy--check-accumulation-compatibility loopy--loop-name var 'list cmd) `((loopy--accumulation-vars (,var nil)) @@ -2491,7 +2499,8 @@ EXPR is the value to bind to VAR." `((loopy--accumulation-vars (,var nil)) (loopy--main-body (loopy--optimized-accum '( :loop ,loopy--loop-name :var ,var - :val ,val :cmd ,cmd :name ,name :at ,pos))) + :val ,val :cmd ,cmd :name ,name :at ,pos + :opt-accum-fn loopy--construct-accum-nconc))) (loopy--implicit-return ,var)))) ;;;;;;; Nunion @@ -2562,7 +2571,8 @@ This function is used by `loopy--expand-optimized-accum'." (loopy--main-body (loopy--optimized-accum '( :loop ,loopy--loop-name :var ,var :val ,val :cmd ,cmd :name ,name :at ,pos - :key ,key :test ,test))))) + :key ,key :test ,test + :opt-accum-fn loopy--construct-accum-nunion))))) (loopy--check-accumulation-compatibility loopy--loop-name var 'list cmd) `((loopy--accumulation-vars (,var nil)) ,@(cond @@ -2598,7 +2608,8 @@ This function is used by `loopy--expand-optimized-accum'." (loopy--main-body (loopy--optimized-accum '( :loop ,loopy--loop-name :var ,var :val ,val :cmd ,cmd :name ,name :at ,pos - :key ,key :test ,test)))))) + :key ,key :test ,test + :opt-accum-fn loopy--construct-accum-nunion)))))) ;;;;;;; Prepend (defun loopy--parse-prepend-command (arg) @@ -2750,7 +2761,8 @@ This function is used by `loopy--expand-optimized-accum'." (loopy--main-body (loopy--optimized-accum '( :loop ,loopy--loop-name :var ,var :val ,val :cmd ,cmd :name ,name :at ,pos - :key ,key :test ,test))))) + :key ,key :test ,test + :opt-accum-fn loopy--construct-accum-union))))) (loopy--check-accumulation-compatibility loopy--loop-name var 'list cmd) `((loopy--accumulation-vars (,var nil)) ,@(cond @@ -2786,7 +2798,8 @@ This function is used by `loopy--expand-optimized-accum'." (loopy--main-body (loopy--optimized-accum '( :loop ,loopy--loop-name :var ,var :val ,val :cmd ,cmd :name ,name :at ,pos - :key ,key :test ,test)))))) + :key ,key :test ,test + :opt-accum-fn loopy--construct-accum-union)))))) ;;;;;;; Vconcat (defun loopy--construct-accum-vconcat (plist) @@ -2832,7 +2845,8 @@ This function is called by `loopy--expand-optimized-accum'." (loopy--main-body (loopy--optimized-accum '( :loop ,loopy--loop-name :var ,var :val ,val - :cmd ,cmd :name ,name :at ,pos))))) + :cmd ,cmd :name ,name :at ,pos + :opt-accum-fn loopy--construct-accum-vconcat))))) (loopy--check-accumulation-compatibility loopy--loop-name var 'vector cmd) `((loopy--accumulation-vars (,var nil)) @@ -2857,7 +2871,8 @@ This function is called by `loopy--expand-optimized-accum'." (loopy--main-body (loopy--optimized-accum '( :loop ,loopy--loop-name :var ,var :val ,val - :cmd ,cmd :name ,name :at ,pos))) + :cmd ,cmd :name ,name :at ,pos + :opt-accum-fn loopy--construct-accum-vconcat))) (loopy--implicit-return ,var)))) ;;;;; Boolean Commands @@ -3090,19 +3105,16 @@ Return a single list of instructions in the same order as COMMAND-LIST." (mapcan #'loopy--parse-loop-command command-list)) -(cl-defun loopy--get-command-parser (command-name &key (parsers loopy-command-parsers)) +(cl-defun loopy--get-command-parser (command-name) "Get the parsing function for COMMAND-NAME. -The following variables are checked: - -1. `loopy-aliases' -2. `loopy-command-parsers' or the value of PARSERS - Failing that, an error is signaled." - - (let ((true-name (loopy--get-true-name command-name))) - (or (map-elt parsers true-name) - (signal 'loopy-unknown-command (list command-name))))) + (or (map-elt loopy--parsers-internal command-name) + (when-let* ((found (map-elt loopy--obsolete-aliases command-name))) + (warn "`loopy': `%s' is an obsolete built-in alias of `%s'. It will be removed in the future. To add it as a custom alias, add it to `loopy-parsers'." + command-name found) + (map-elt loopy--parsers-internal found)) + (signal 'loopy-unknown-command (list command-name)))) (provide 'loopy-commands) diff --git a/lisp/loopy-iter.el b/lisp/loopy-iter.el index 915a7e90b1..10b941dc82 100644 --- a/lisp/loopy-iter.el +++ b/lisp/loopy-iter.el @@ -170,26 +170,6 @@ For special marco arguments, see `loopy-iter-bare-special-macro-arguments'." :type '(repeat symbol) :group 'loopy-iter) -(defvar loopy-iter--command-parsers nil - "Parsers used by `loopy-iter'. - -This variable is bound while `loopy-iter' is running, combining -`loopy-command-parsers' and -`loopy-iter-overwritten-command-parsers'.") - -(defun loopy-iter--parse-command (command) - "Parse COMMAND using parsers in`loopy-iter--command-parsers'. - -See also `loopy--parse-loop-command'." - (let* ((cmd-name (cl-first command)) - (parser (loopy--get-command-parser - cmd-name - :parsers loopy-iter--command-parsers)) - (instructions (remq nil (funcall parser command)))) - (or instructions - (signal 'loopy-parser-instructions-missing - (list command parser))))) - (defvar loopy-iter--non-main-body-instructions nil "Used to capture other instructions while expanding. @@ -239,8 +219,8 @@ during a second pass on the expanded code." '((at . loopy-iter--parse-at-command)) "Overwritten command parsers. -This is an alist of dotted pairs of base names and parsers, as in -`loopy-command-parsers'. +This is an alist of dotted pairs of base names and parsers, similar to +`loopy-parsers', except that this variable is an alist. Some parsers reasonably assume that all of their body arguments are also commands. For `loopy-iter', this cannot work, so some parsers @@ -312,64 +292,62 @@ Variables available: - `arg-value' is the value of the arg if there is only one match - `arg-name' the name of the arg found if there is only one match" (declare (indent defun)) - `(defun ,(intern (format "loopy-iter--process-special-arg-%s" name)) - (body) - ,(format "Process the special macro argument `%s' and its aliases. + (let ((fn-sym `(quote ,(intern (format "loopy--parse-%s-special-macro-argument" name))))) + `(defun ,(intern (format "loopy-iter--process-special-arg-%s" name)) + (body) + ,(format "Process the special macro argument `%s' and its aliases. Returns BODY without the `%s' argument." - name name) - (loopy - (accum-opt matching-args new-body) - (with (all-names (loopy--get-all-names (quote ,name) :from-true t)) - (bare-names (loopy (list name all-names) - (when (memq name loopy-iter-bare-special-macro-arguments) - (collect name))))) - (listing expr body) - (if (and (consp expr) - (or (memq (cl-first expr) bare-names) - (and (memq (cl-first expr) loopy-iter-keywords) - (memq (cl-second expr) all-names)))) - (collecting matching-args expr) - (collecting new-body expr)) - (finally-do (when matching-args - (if (cdr matching-args) - (error "Conflicting arguments: %s" matching-args) - (let ((arg (car matching-args)) - (arg-name) - (arg-value)) - ;; TODO: Probably a better way to do this that doesn't - ;; involve checking twice. - (if (memq (cl-first arg) bare-names) - (loopy-setq (arg-name . arg-value) arg) - (loopy-setq (_ arg-name . arg-value) arg)) - (ignore arg-name) - ,@body)))) - (finally-return - new-body)))) + name name) + (loopy + (accum-opt matching-args new-body) + (listing expr body) + (if (and (consp expr) + (let ((first (cl-first expr))) + (or (and (memq first loopy-iter-keywords) + (eq ,fn-sym (loopy--get-command-parser (cl-second expr)))) + (and (memq first loopy-iter-bare-special-macro-arguments) + (eq ,fn-sym (loopy--get-command-parser first)))))) + (collecting matching-args expr) + (collecting new-body expr)) + (finally-do (when matching-args + (if (cdr matching-args) + (error "Conflicting arguments: %s" matching-args) + (let ((arg (car matching-args)) + (arg-name) + (arg-value)) + ;; TODO: Probably a better way to do this that doesn't + ;; involve checking twice. + (if (memq (cl-first arg) loopy-iter-keywords) + (loopy-setq (_ arg-name . arg-value) arg) + (loopy-setq (arg-name . arg-value) arg)) + (ignore arg-name) + ,@body)))) + (finally-return + new-body))))) (defun loopy-iter--process-special-arg-loop-name (body) "Process BODY and the loop name listed therein." (let* ((names) - (new-body) - (all-sma-names (loopy--get-all-names 'named :from-true t)) - (all-sma-bare-names - (loopy (list name all-sma-names) - (when (memq name loopy-iter-bare-special-macro-arguments) - (collect name))))) + (new-body)) (dolist (arg body) - (cond ((symbolp arg) - (push arg names)) - ((memq (car-safe arg) all-sma-bare-names) - (if (/= 2 (length arg)) - (error "Wrong number of arguments for loop name: %s" arg) - (push (cl-second arg) names))) - ((and (memq (car-safe arg) loopy-iter-keywords) - (memq (cl-second arg) all-sma-names)) - (if (/= 3 (length arg)) - (error "Wrong number of arguments for loop name: %s" arg) - (push (cl-third arg) names))) - (t (push arg new-body)))) - (if (> (length names) 1) + (pcase arg + ((pred symbolp) + (push arg names)) + ((or `(,(pred (lambda (x) (memq x loopy-iter-keywords))) + ,(pred (lambda (x) (eq 'loopy--parse-named-special-macro-argument + (loopy--get-command-parser x)))) + ,name . ,rest) + `(,(and (pred (lambda (x) (memq x loopy-iter-bare-special-macro-arguments))) + (pred (lambda (x) (eq 'loopy--parse-named-special-macro-argument + (loopy--get-command-parser x))))) + ,name . ,rest)) + (if (null rest) + (push name names) + (error "Wrong number of arguments for loop name: %s" arg))) + (_ + (push arg new-body)))) + (if (length> names 1) (error "Conflicting loop names: %s" names) (let ((loop-name (cl-first names))) ; Symbol or `nil'. (setq loopy--loop-name loop-name @@ -482,6 +460,24 @@ to use `loopy' in general. ;; do in `loopy'. (loopy--wrap-variables-around-body +;;;;; Process obsolete variables + (setq loopy--parsers-internal (copy-hash-table loopy-parsers)) + (when loopy-command-parsers + (map-do (lambda (k v) + (puthash k v loopy--parsers-internal)) + loopy-command-parsers)) + + ;; NOTE: This one isn't obsolete but needs to happen before aliases. + (when loopy-iter-overwritten-command-parsers + (map-do (lambda (k v) + (puthash k v loopy--parsers-internal)) + loopy-iter-overwritten-command-parsers)) + + (when loopy-aliases + (pcase-dolist (`(,orig . ,aliases) loopy-aliases) + (let ((parser (gethash orig loopy--parsers-internal))) + (dolist (alias aliases) + (puthash alias parser loopy--parsers-internal))))) (mapc #'loopy--apply-flag loopy-default-flags) @@ -501,9 +497,6 @@ to use `loopy' in general. (loopy--with-protected-stack (let* ((suppressed-expanders (loopy (list i loopy-iter-suppressed-macros) (collect (cons i nil)))) - (loopy-iter--command-parsers (or loopy-iter--command-parsers - (append loopy-iter-overwritten-command-parsers - loopy-command-parsers))) (loopy-iter--non-main-body-instructions) (loopy-iter--level 0) (command-env @@ -517,7 +510,7 @@ to use `loopy' in general. ;; while parsing an actual top-level command. (let* ((loopy-iter--level (1+ loopy-iter--level)) (loopy--in-sub-level (> loopy-iter--level 1))) - (loopy-iter--parse-command args)) + (loopy--parse-loop-command args)) (push other loopy-iter--non-main-body-instructions) (macroexp-progn main)))))) (loopy (list command loopy-iter-bare-commands) @@ -536,7 +529,7 @@ to use `loopy' in general. ;; top-level command. (let* ((loopy-iter--level (1+ loopy-iter--level)) (loopy--in-sub-level (> loopy-iter--level 1))) - (loopy-iter--parse-command (cons cmd args))) + (loopy--parse-loop-command (cons cmd args))) (push other loopy-iter--non-main-body-instructions) (macroexp-progn main))))))))) (common-env `(,@suppressed-expanders @@ -597,8 +590,9 @@ to use `loopy' in general. See the info node `(loopy)The loopy-iter Macro' for more." `((loopy--main-body ,(macroexpand `(loopy-iter ,@body))))) -(cl-callf map-insert loopy-command-parsers - 'loopy-iter #'loopy-iter--parse-loopy-iter-command) +(puthash 'loopy-iter + #'loopy-iter--parse-loopy-iter-command + loopy-parsers) (provide 'loopy-iter) ;;; loopy-iter.el ends here diff --git a/lisp/loopy-vars.el b/lisp/loopy-vars.el index e306700fa5..917bddeaf7 100644 --- a/lisp/loopy-vars.el +++ b/lisp/loopy-vars.el @@ -51,192 +51,305 @@ This is a list of symbols, each symbol corresponding to a function in the variable `loopy--flag-settings'." :type '(repeat symbol)) +(defun loopy--defalias-1 (alias definition) + (if (eq alias definition) + (error "Can't alias name to itself: `%s' -> `%s'" + alias definition) + (let ((true-name + ;; Now that `loopy-aliases' is nil, we know that it can only + ;; contain the true name by user intervention, in which + ;; case it should have priority over `loopy-parsers'. + (or (cl-loop for (orig . aliases) in loopy-aliases + when (memq definition aliases) + return orig) + (and (map-contains-key loopy-parsers definition) + definition) + (when-let* ((orig (gethash definition loopy--obsolete-aliases))) + (warn "`loopy': `%s' is an obsolete built-in alias of `%s'. It will be removed in the future. To add it as a custom alias, add it to `loopy-parsers'." + definition orig) + orig)))) + (if (eq alias true-name) + (error "Can't alias name to itself: `%s' -> `%s' -> ... -> `%s'" + alias definition true-name) + (if-let* ((fn (gethash true-name loopy-parsers))) + (progn + ;; Remove previous uses of that alias from all other names. + ;; We don't want to trigger the setting warning unless we must, + ;; so we check first. + (when (map-some (lambda (_ v) (memq alias v)) + loopy-aliases) + (setq loopy-aliases (map-apply (lambda (k v) + (cons k (remq alias v))) + loopy-aliases))) + ;; Add the alias for the new target name. + (puthash alias fn loopy-parsers)) + (error "Ultimate command `%S' for alias `%S' to `%S' is not a known command" + true-name alias definition)))))) + ;;;###autoload (defmacro loopy-defalias (alias definition) "Add alias ALIAS for loop command DEFINITION. Definition must exist. Neither argument need be quoted." - `(let ((alias (quote ,(loopy--get-quoted-symbol alias))) - (definition (quote ,(loopy--get-quoted-symbol definition)))) - (let ((true-name (loopy--get-true-name definition))) - (cond - ((eq alias definition) - (error "Can't alias name to itself: `%s' -> `%s'" - alias definition)) - ((eq alias true-name) - (error "Can't alias name to itself: `%s' -> `%s' -> ... -> `%s'" - alias definition true-name)) - (t - ;; Remove previous uses of that alias from all other names. - (setq loopy-aliases (map-apply (lambda (k v) - (cons k (remq alias v))) - loopy-aliases)) - ;; Add the alias for the new target name. - (push alias (map-elt loopy-aliases true-name))))))) + `(loopy--defalias-1 (quote ,(loopy--get-quoted-symbol alias)) + (quote ,(loopy--get-quoted-symbol definition)))) (defvar loopy--obsolete-aliases - '((array across) - (array-ref arrayf arrayingf stringf stringingf across-ref) - (command-do group) - (cons on) - (list in) - (list-ref listf listingf in-ref) - (map-ref mapf mappingf) - (numbers num nums) - (numbers-down nums-down numdown num-down numsdown) - (numbers-up nums-up numup num-up numsup) - (set exprs expr) - (set-prev prev prev-expr) - (sequence elements) - (sequence-index sequencei seqi listi arrayi stringi) - (seq-ref seqf seqingf) - (sequence-ref sequencef sequencingf elements-ref)) + #s(hash-table + test eq + data ( across array + arrayf array-ref + arrayingf array-ref + stringf array-ref + stringingf array-ref + across-ref array-ref + group command-do + on cons + in list + listf list-ref + listingf list-ref + in-ref list-ref + mapf map-ref + mappingf map-ref + num numbers + nums numbers + nums-down numbers-down + numdown numbers-down + num-down numbers-down + numsdown numbers-down + nums-up numbers-up + numup numbers-up + num-up numbers-up + numsup numbers-up + exprs set + expr set + prev set-prev + prev-expr set-prev + elements sequence + sequencei sequence-index + seqi sequence-index + listi sequence-index + arrayi sequence-index + stringi sequence-index + seqf seq-ref + seqingf seq-ref + sequencef sequence-ref + sequencingf sequence-ref + elements-ref sequence-ref)) "Aliases to be removed from the documentation.") -;;;###autoload -(defcustom loopy-aliases - ;; TODO: Is there a faster way to search for aliases? - ;; Would using a hash table with a flatter structure be better? - ;; Using `map-do' on a hash table seemed to be a bit slower for what - ;; we want? - '((accumulate . (accumulating callf2)) - (adjoin . (adjoining)) - (after-do . (else after else-do)) - (append . (appending)) - (array . (arraying string stringing)) - (array-ref . (arraying-ref string-ref stringing-ref)) - (at . (atting)) - (before-do . (initially-do initially before)) - (collect . (collecting)) - (concat . (concating)) - (cons . (conses consing)) - (count . (counting)) - (cycle . (cycling repeat repeating)) - (finally-do . (finally)) - (finally-protect . (finally-protected)) - (find . (finding)) - (flag . (flags)) - (iter . (iterating)) - (leave . (leaving)) - (leave-from . (leaving-from)) - (list . (listing each)) - (list-ref . (listing-ref)) - (map . (mapping map-pairs mapping-pairs)) - (map-ref . (mapping-ref)) - (max . (maximizing maximize maxing)) - ;; Unlike "maxing", there doesn't seem to be much on-line about the word - ;; "minning", but the double-N follows conventional spelling rules, such as - ;; in "sum" and "summing". - (min . (minimizing minimize minning)) - (multiply . (multiplying)) - (nconc . (nconcing)) - (numbers . (number numbering)) - (numbers-down . (number-down numbering-down)) - (numbers-up . (number-up numbering-up)) - (nunion . (nunioning)) - (opt-accum . (accum-opt)) - (prepend . (prepending)) - (push-into . (push pushing pushing-into)) - (reduce . (reducing callf)) - (return . (returning)) - (return-from . (returning-from)) - (set . (setting)) - (set-accum . (setting-accum)) - (set-prev . (setting-prev prev-set)) - (sequence . (sequencing)) - (seq . (seqing)) - (sequence-index . ( seq-index seqing-index - sequencing-index - list-index listing-index - array-index arraying-index - string-index stringing-index)) - (seq-ref . (seqing-ref)) - (sequence-ref . (sequencing-ref)) - (skip . (skipping continue continuing)) - (skip-from . (skipping-from continue-from continuing-from)) - (stream . (streaming)) - (substream . (substreaming)) - (sum . (summing)) - (union . (unioning)) - (vconcat . (vconcating)) - (with . (let* init)) - (without . (no-with no-init))) - "Aliases for loopy commands and special macro arguments. +(defun loopy--expression-parser-map-p (obj) + "Return when OBJ has the correct data for `loopy-expression-parsers'." + (and (mapp obj) + (map-every-p (lambda (k v) + (and (symbolp k) + (or (functionp v) + (and (symbolp k) + (string-match-p "loopy--parse-.*-special-macro-argument" + (symbol-name v)))))) + obj))) -This variable should not be modified directly. For forward -compatibility, use `loopy-defalias'. For now, these are pairs of -true names and lists of aliases. +(defvar loopy--parsers-internal nil + "Internal version of `loopy-parsers' for current expansion.") - This user option is an alternative to modifying -`loopy-command-parsers' when the command parser is unknown." +;;;###autoload +(defcustom loopy-parsers + #s(hash-table + test eq + data (;; Special macro arguments + accum-opt loopy--parse-accum-opt-special-macro-argument + opt-accum loopy--parse-accum-opt-special-macro-argument + after loopy--parse-after-do-special-macro-argument + after-do loopy--parse-after-do-special-macro-argument + else loopy--parse-after-do-special-macro-argument + else-do loopy--parse-after-do-special-macro-argument + before loopy--parse-before-do-special-macro-argument + before-do loopy--parse-before-do-special-macro-argument + initially loopy--parse-before-do-special-macro-argument + initially-do loopy--parse-before-do-special-macro-argument + finally loopy--parse-finally-do-special-macro-argument + finally-do loopy--parse-finally-do-special-macro-argument + finally-protect loopy--parse-finally-protect-special-macro-argument + finally-protected loopy--parse-finally-protect-special-macro-argument + finally-return loopy--parse-finally-return-special-macro-argument + flag loopy--parse-flag-special-macro-argument + flags loopy--parse-flag-special-macro-argument + init loopy--parse-with-special-macro-argument + let* loopy--parse-with-special-macro-argument + with loopy--parse-with-special-macro-argument + no-init loopy--parse-without-special-macro-argument + no-with loopy--parse-without-special-macro-argument + without loopy--parse-without-special-macro-argument + named loopy--parse-named-special-macro-argument + wrap loopy--parse-wrap-special-macro-argument + + ;; Loop Commands + accumulate loopy--parse-accumulate-command + accumulating loopy--parse-accumulate-command + callf2 loopy--parse-accumulate-command + adjoin loopy--parse-adjoin-command + adjoining loopy--parse-adjoin-command + always loopy--parse-always-command + append loopy--parse-append-command + appending loopy--parse-append-command + array loopy--parse-array-command + arraying loopy--parse-array-command + string loopy--parse-array-command + stringing loopy--parse-array-command + array-ref loopy--parse-array-ref-command + arraying-ref loopy--parse-array-ref-command + string-ref loopy--parse-array-ref-command + stringing-ref loopy--parse-array-ref-command + at loopy--parse-at-command + atting loopy--parse-at-command + collect loopy--parse-collect-command + collecting loopy--parse-collect-command + command-do loopy--parse-command-do-command + concat loopy--parse-concat-command + concating loopy--parse-concat-command + cond loopy--parse-cond-command + cons loopy--parse-cons-command + conses loopy--parse-cons-command + consing loopy--parse-cons-command + count loopy--parse-count-command + counting loopy--parse-count-command + cycle loopy--parse-cycle-command + cycling loopy--parse-cycle-command + repeat loopy--parse-cycle-command + repeating loopy--parse-cycle-command + do loopy--parse-do-command + find loopy--parse-find-command + finding loopy--parse-find-command + if loopy--parse-if-command + iter loopy--parse-iter-command + iterating loopy--parse-iter-command + leave loopy--parse-leave-command + leaving loopy--parse-leave-command + leave-from loopy--parse-leave-from-command + leaving-from loopy--parse-leave-from-command + each loopy--parse-list-command + list loopy--parse-list-command + listing loopy--parse-list-command + list-ref loopy--parse-list-ref-command + listing-ref loopy--parse-list-ref-command + loopy loopy--parse-loopy-command + map loopy--parse-map-command + map-pairs loopy--parse-map-command + mapping loopy--parse-map-command + mapping-pairs loopy--parse-map-command + map-ref loopy--parse-map-ref-command + mapping-ref loopy--parse-map-ref-command + max loopy--parse-max-command + maximize loopy--parse-max-command + maximizing loopy--parse-max-command + maxing loopy--parse-max-command + min loopy--parse-min-command + minimize loopy--parse-min-command + minimizing loopy--parse-min-command + minning loopy--parse-min-command + multiply loopy--parse-multiply-command + multiplying loopy--parse-multiply-command + nconc loopy--parse-nconc-command + nconcing loopy--parse-nconc-command + never loopy--parse-never-command + number loopy--parse-numbers-command + numbering loopy--parse-numbers-command + numbers loopy--parse-numbers-command + number-down loopy--parse-numbers-down-command + numbering-down loopy--parse-numbers-down-command + numbers-down loopy--parse-numbers-down-command + number-up loopy--parse-numbers-up-command + numbering-up loopy--parse-numbers-up-command + numbers-up loopy--parse-numbers-up-command + nunion loopy--parse-nunion-command + nunioning loopy--parse-nunion-command + prepend loopy--parse-prepend-command + prepending loopy--parse-prepend-command + push loopy--parse-push-into-command + push-into loopy--parse-push-into-command + pushing loopy--parse-push-into-command + pushing-into loopy--parse-push-into-command + callf loopy--parse-reduce-command + reduce loopy--parse-reduce-command + reducing loopy--parse-reduce-command + return loopy--parse-return-command + returning loopy--parse-return-command + return-from loopy--parse-return-from-command + returning-from loopy--parse-return-from-command + seq loopy--parse-seq-command + seqing loopy--parse-seq-command + seq-ref loopy--parse-seq-ref-command + seqing-ref loopy--parse-seq-ref-command + sequence loopy--parse-sequence-command + sequencing loopy--parse-sequence-command + array-index loopy--parse-sequence-index-command + arraying-index loopy--parse-sequence-index-command + list-index loopy--parse-sequence-index-command + listing-index loopy--parse-sequence-index-command + seq-index loopy--parse-sequence-index-command + seqing-index loopy--parse-sequence-index-command + sequence-index loopy--parse-sequence-index-command + sequencing-index loopy--parse-sequence-index-command + string-index loopy--parse-sequence-index-command + stringing-index loopy--parse-sequence-index-command + sequence-ref loopy--parse-sequence-ref-command + sequencing-ref loopy--parse-sequence-ref-command + set-accum loopy--parse-set-accum-command + setting-accum loopy--parse-set-accum-command + set loopy--parse-set-command + setting loopy--parse-set-command + prev-set loopy--parse-set-prev-command + set-prev loopy--parse-set-prev-command + setting-prev loopy--parse-set-prev-command + continue loopy--parse-skip-command + continuing loopy--parse-skip-command + skip loopy--parse-skip-command + skipping loopy--parse-skip-command + continue-from loopy--parse-skip-from-command + continuing-from loopy--parse-skip-from-command + skip-from loopy--parse-skip-from-command + skipping-from loopy--parse-skip-from-command + stream loopy--parse-stream-command + streaming loopy--parse-stream-command + substream loopy--parse-substream-command + substreaming loopy--parse-substream-command + sum loopy--parse-sum-command + summing loopy--parse-sum-command + thereis loopy--parse-thereis-command + union loopy--parse-union-command + unioning loopy--parse-union-command + vconcat loopy--parse-vconcat-command + vconcating loopy--parse-vconcat-command + unless loopy--parse-when-unless-command + when loopy--parse-when-unless-command + until loopy--parse-while-until-commands + while loopy--parse-while-until-commands + loopy-iter loopy-iter--parse-loopy-iter-command)) + "Map of symbols to parsing functions. + +This includes special macro arguments in addition to the loop commands. + +Functions for special macro arguments are fake entries. These entries +are used to identify special macro arguments. These entries are _not_ +used to find the function which parses special macro arguments. How +special macro arguments are parsed is not configurable. Special macro +arguments are handled specially. See the Info node +`(loopy)Special Macro Arguments'. + +Functions for parsing custom loop commands can be added to this mapping, +which are used after special macro arguments are processed. See the Info node +`(loopy)Loop Commands' and the Info node `(loopy)Custom Commands'." :group 'loopy - :type '(alist :key-type symbol :value-type (repeat symbol))) + :type '(restricted-sexp :match-alternatives (loopy--expression-parser-map-p))) + +(make-obsolete-variable 'loopy-command-parsers 'loopy-parsers "2025-07" 'set) +(defcustom loopy-command-parsers nil -;;;###autoload -(defcustom loopy-command-parsers - ;; TODO: This would probably be faster as a hash table, - ;; but then not as customizable. - '((accumulate . loopy--parse-accumulate-command) - (always . loopy--parse-always-command) - (append . loopy--parse-append-command) - (adjoin . loopy--parse-adjoin-command) - (array . loopy--parse-array-command) - (array-ref . loopy--parse-array-ref-command) - (at . loopy--parse-at-command) - (collect . loopy--parse-collect-command) - (command-do . loopy--parse-command-do-command) - (concat . loopy--parse-concat-command) - (cond . loopy--parse-cond-command) - (cons . loopy--parse-cons-command) - (count . loopy--parse-count-command) - (cycle . loopy--parse-cycle-command) - (do . loopy--parse-do-command) - (find . loopy--parse-find-command) - (set-accum . loopy--parse-set-accum-command) - (if . loopy--parse-if-command) - (iter . loopy--parse-iter-command) - (leave . loopy--parse-leave-command) - (leave-from . loopy--parse-leave-from-command) - (list . loopy--parse-list-command) - (list-ref . loopy--parse-list-ref-command) - (loopy . loopy--parse-loopy-command) - (map . loopy--parse-map-command) - (map-ref . loopy--parse-map-ref-command) - (max . loopy--parse-max-command) - (min . loopy--parse-min-command) - (multiply . loopy--parse-multiply-command) - (never . loopy--parse-never-command) - (nconc . loopy--parse-nconc-command) - (numbers . loopy--parse-numbers-command) - (numbers-up . loopy--parse-numbers-up-command) - (numbers-down . loopy--parse-numbers-down-command) - (nunion . loopy--parse-nunion-command) - (prepend . loopy--parse-prepend-command) - (push-into . loopy--parse-push-into-command) - (reduce . loopy--parse-reduce-command) - (return . loopy--parse-return-command) - (return-from . loopy--parse-return-from-command) - (seq . loopy--parse-seq-command) - (sequence . loopy--parse-sequence-command) - (sequence-index . loopy--parse-sequence-index-command) - (seq-ref . loopy--parse-seq-ref-command) - (sequence-ref . loopy--parse-sequence-ref-command) - (set . loopy--parse-set-command) - (set-prev . loopy--parse-set-prev-command) - (skip . loopy--parse-skip-command) - (skip-from . loopy--parse-skip-from-command) - (stream . loopy--parse-stream-command) - (substream . loopy--parse-substream-command) - (sum . loopy--parse-sum-command) - (thereis . loopy--parse-thereis-command) - (union . loopy--parse-union-command) - (unless . loopy--parse-when-unless-command) - (until . loopy--parse-while-until-commands) - (vconcat . loopy--parse-vconcat-command) - (when . loopy--parse-when-unless-command) - (while . loopy--parse-while-until-commands)) "An alist of pairs of a quoted command name and a parsing function. +This variable is obsolete. See instead the customizable variable +`loopy-parsers'. + The parsing function is chosen based on the command name (such as `list' in `(list i my-list)'), not the usage of the command. That is, @@ -259,6 +372,21 @@ exist), one could do :group 'loopy :type '(alist :key-type symbol :value-type function)) +(make-obsolete-variable 'loopy-aliases 'loopy-parsers "2025-07" 'set) +(defcustom loopy-aliases nil + "Aliases for loopy commands and special macro arguments. + +This variable is obsolete. See instead the customizable variable +`loopy-parsers'. + +This variable should not be modified directly. For forward +compatibility, use `loopy-defalias'. For now, these are pairs of +true names and lists of aliases. + + This user option is an alternative to modifying +`loopy-command-parsers' when the command parser is unknown." + :group 'loopy + :type '(alist :key-type symbol :value-type (repeat symbol))) ;;;; Flags @@ -320,28 +448,6 @@ Each item is of the form (FLAG . FLAG-ENABLING-FUNCTION).") ;; might be cleaner code to modify from the parsing function, after the macro ;; has already set them to nil. -(defvar loopy--special-macro-arguments - '( flag with without before-do after-do finally-do finally-return wrap - finally-protect accum-opt) - "List of base names of built-in special macro arguments. - -These are only the base names as found in `loopy-aliases'.") - -(defvar loopy--special-maro-argument-processors - '(loopy--process-special-arg-loop-name - loopy--process-special-arg-flag - loopy--process-special-arg-with - loopy--process-special-arg-without - loopy--process-special-arg-accum-opt - loopy--process-special-arg-wrap - loopy--process-special-arg-before-do - loopy--process-special-arg-after-do - loopy--process-special-arg-finally-do - loopy--process-special-arg-finally-return - loopy--process-special-arg-finally-protect) - "Processing functions for special macro arguments. -These functions must be run in order.") - (defvar loopy--loop-name nil "A symbol that names the loop, appropriate for use in `cl-block'.") @@ -350,7 +456,6 @@ These functions must be run in order.") This is used to check for errors with the `at' command.") - (defvar loopy--flags nil "Symbols/flags whose presence changes the behavior of `loopy'. @@ -395,8 +500,6 @@ just wrap the macro expression as you normally would.") "A list of expressions to evaluate before the loop starts. This is done using a `progn'.") - - ;;;; Loop Commands ;;;;; At Commands @@ -621,21 +724,6 @@ CMD-NAME is used for signaling errors." (or (map-nested-elt loopy--accumulation-places (list loop var)) (signal 'loopy-missing-accum-counters (list cmd-name)))) -(defvar loopy--accumulation-constructors - '((adjoin . loopy--construct-accum-adjoin) - (append . loopy--construct-accum-append) - (prepend . loopy--construct-accum-append) - (collect . loopy--construct-accum-collect) - (push-into . loopy--construct-accum-collect) - (concat . loopy--construct-accum-concat) - (nconc . loopy--construct-accum-nconc) - (nunion . loopy--construct-accum-nunion) - (union . loopy--construct-accum-union) - (vconcat . loopy--construct-accum-vconcat)) - "Functions that produce the code of an optimized accumulation. - -This is used by the function `loopy--get-optimized-accum'.") - (defvar loopy--optimized-accum-vars nil "Explicit accumulations variables to optimize. @@ -665,6 +753,8 @@ known to fall into the first group.") loopy--final-protect loopy--final-return + loopy--parsers-internal + ;; -- Vars for processing loop commands -- ;; NOTE: `loopy--at-instructions' cannot be local to each loop: ;; loopy--at-instructions @@ -791,55 +881,5 @@ This predicate checks for presence in the list `loopy--valid-external-at-targets'." (memq target loopy--valid-external-at-targets)) -(cl-defun loopy--get-true-name (name) - "Get the true name of possible alias NAME." - (or (progn - ;; Defensively return nil, since `map-do' in older versions - ;; of `map.el' failed to return nil correctly. - (map-do (lambda (k v) - (when (memq name v) - (cl-return-from loopy--get-true-name k))) - loopy-aliases) - (map-do (lambda (k v) - (when (memq name v) - (warn "`loopy': `%s' is an obsolete built-in alias of `%s'. It will be removed in the future. To add it as a custom alias, use `loopy-defalias'." - name k) - (cl-return-from loopy--get-true-name k))) - loopy--obsolete-aliases) - nil) - name)) - -(defun loopy--get-aliases (true-name) - "Get the immediate aliases of TRUE-NAME. - -See also `loopy--get-all-names', for when the true name -is not known." - (map-elt loopy-aliases true-name)) - -(cl-defun loopy--get-all-names (name &key from-true ignored) - "Get the true name of NAME and all of the true name's aliases. - -If FROM-TRUE is non-nil, NAME is the true name. IGNORED is a -list of names to be removed from the list of found names. - -If no other names are found, a list of just NAME is returned. -This function does not check whether a name is known." - (let ((names (if from-true - (cons name (loopy--get-aliases name)) - (or (progn - ;; Defensively return nil, since `map-do' in - ;; older versions of `map.el' failed to - ;; return nil correctly. - (map-do (lambda (k v) - (when (or (eq name k) (memq name v)) - (cl-return-from loopy--get-all-names - (cons k v)))) - loopy-aliases) - nil) - (list name))))) - (if ignored - (seq-difference names ignored #'eq) - names))) - (provide 'loopy-vars) ;;; loopy-vars.el ends here diff --git a/lisp/loopy.el b/lisp/loopy.el index 04b12dfa0b..a96882c310 100644 --- a/lisp/loopy.el +++ b/lisp/loopy.el @@ -224,26 +224,6 @@ Returns a list of two elements: (push `(_ ,set-expr) new-binds)))))) (list 'let* (nreverse new-binds)))) -(cl-defun loopy--find-special-macro-arguments (names body) - "Find any usages of special macro arguments NAMES in BODY, given aliases. - -NAMES can be either a single quoted name or a list of quoted names. - -Aliases can be found in `loopy-aliases'." - (let ((aliases (map-pairs loopy-aliases))) - (dolist (keyword - (if (listp names) - (append names - (cl-loop for alias in aliases - if (memq (cdr alias) names) - collect (car alias))) - (cons names (cl-loop for alias in aliases - if (eq (cdr alias) names) - collect (car alias))))) - (when-let ((target (cdr (assq keyword body)))) - (cl-return-from loopy--find-special-macro-arguments target))))) - - ;;;; The Macro Itself (defun loopy--expand-to-loop () "Create the loop body according to the variables found in `loopy--variables'. @@ -450,30 +430,6 @@ The function creates quoted code that should be used by a macro." ;; Return the constructed code. result))) -(defmacro loopy--process-special-marco-args (names &rest body) - "Process the special macro arguments named by NAMES. - -BODY is the processing. - -Variables available: -- `all-names' is all of the names found -- `such-args' are all arguments that match elements in - `all-names' -- `arg-value' is the value of the arg if there is only one match -- `arg-name' the name of the arg found if there is only one match" - (declare (indent 1)) - `(let* ((all-names (loopy--get-all-names ,names)) - (such-args (map-filter (lambda (arg-name _) - (memq arg-name all-names)) - body))) - (cl-case (length such-args) - (0 nil) - (1 (let ((arg-name (caar such-args)) - (arg-value (cdar such-args))) - (ignore arg-value) - ,@body)) - (t (error "Conflicting arguments: %s" such-args))))) - ;;;; Create special arg processors (defmacro loopy--def-special-processor (name &rest body) "Create a processor for the special macro argument NAME and its aliases. @@ -484,23 +440,21 @@ in `loopy--variables') and return a new BODY with its own argument removed. Variables available: -- `all-names' is all of the names found - `matching-args' are all arguments that match elements in `all-names' - `arg-value' is the value of the arg if there is only one match - `arg-name' the name of the arg found if there is only one match" (declare (indent defun)) `(defun ,(intern (format "loopy--process-special-arg-%s" name)) - (body &optional ignored) + (body) ,(format "Process the special macro argument `%s' and its aliases. Returns BODY without the `%s' argument." name name) - (let* ((all-names (loopy--get-all-names (quote ,name) - :from-true t - :ignored ignored)) - (matching-args (seq-filter (lambda (x) (memq (car-safe x) all-names)) - body))) + (let* ((matching-args (cl-remove-if (lambda (x) + (not (eq (quote ,(intern (format "loopy--parse-%s-special-macro-argument" name))) + (loopy--get-command-parser (car-safe x))))) + body))) (cl-case (length matching-args) (0 body) (1 (let ((arg-name (caar matching-args)) @@ -516,7 +470,8 @@ Returns BODY without the `%s' argument." (dolist (arg body) (cond ((symbolp arg) (push arg names)) - ((and (memq (car-safe arg) (loopy--get-all-names 'named :from-true t))) + ((eq 'loopy--parse-named-special-macro-argument + (loopy--get-command-parser (car-safe arg))) (if (/= 2 (length arg)) (error "Wrong number of arguments for loop name: %s" arg) (push (cl-second arg) names))) @@ -934,6 +889,21 @@ see the Info node `(loopy)' distributed with this package." ;; Bind variables in `loopy--variables' around code to build the expanded ;; loop. (loopy--wrap-variables-around-body +;;;;; Process obsolete variables + ;; Don't copy unless we have to. + (if (not (or loopy-command-parsers loopy-aliases)) + (setq loopy--parsers-internal loopy-parsers) + (setq loopy--parsers-internal (copy-hash-table loopy-parsers)) + (when loopy-command-parsers + (map-do (lambda (k v) + (puthash k v loopy--parsers-internal)) + loopy-command-parsers)) + (when loopy-aliases + (pcase-dolist (`(,orig . ,aliases) loopy-aliases) + (let ((parser (loopy--get-command-parser orig))) + (dolist (alias aliases) + (puthash alias parser loopy--parsers-internal)))))) + ;;;;; Process the special macro arguments. (mapc #'loopy--apply-flag loopy-default-flags) (setq body (loopy--process-special-arg-loop-name body)) diff --git a/tests/install-script.el b/tests/install-script.el index 31c4609155..ff95e2e93e 100644 --- a/tests/install-script.el +++ b/tests/install-script.el @@ -5,6 +5,19 @@ (require 'package) (package-refresh-contents) +;; NOTE: This definition is needed for install Dash for `loopy-dash' for some +;; reason: + +;;;###autoload +(unless (fboundp 'lisp-data-mode) +;;;###autoload + (define-derived-mode lisp-data-mode prog-mode "Lisp-Data" + "Major mode for buffers holding data written in Lisp syntax." + :group 'lisp + (lisp-mode-variables nil t nil) + (setq-local electric-quote-string t) + (setq imenu-case-fold-search nil))) + (message "\nInstall Loopy from tar file:") (let ((tar-files (directory-files default-directory nil "\\`loopy-.*?.tar\\'"))) (cl-assert (= 1 (length tar-files))) diff --git a/tests/tests.el b/tests/tests.el index 2e96f3492a..456dd6ba89 100644 --- a/tests/tests.el +++ b/tests/tests.el @@ -30,6 +30,15 @@ "`loopy' quote: Quote a use of `loopy'." `(eval (quote (loopy ,@body)) t)) +;; This was added in commit d925121b1e1cdf953705a5da43f8092f2a6e1d8c, in 2021 +;; March, whose changes do not seem to be included in the Emacs 27 branch. +;; Adding the method does not seem to fix the tests, so we use a separate +;; function. +(defun my-ht-map-insert (hash-table key value) + (let ((ht (copy-hash-table hash-table))) + (puthash key value ht) + ht)) + ;;; Check for ELC files, which can mess up testing. (ert-deftest no-elc-in-cwd () (should (cl-loop for f in (directory-files ".") @@ -199,27 +208,6 @@ prefix the items in LOOPY or ITER-BARE." :repeat (or repeat repeat-iter-keyword) :keyword t)))) -(defun my-iter-insert (&rest syms-str) - "Insert values for `:iter-keyword' and `:iter-bare'. -SYMS-STR are the string names of symbols from `loopy-iter-bare-commands'." - (interactive (completing-read-multiple "Bare name: " - loopy-iter-bare-commands)) - (let* ((true-names-str (mapcar (lambda (x) - (thread-last x - intern - loopy--get-true-name - symbol-name)) - syms-str))) - (insert (format ":iter-keyword (%s)" - (string-join true-names-str " "))) - (newline-and-indent) - (insert (format ":iter-bare (%s)" - (string-join (cl-loop for true in true-names-str - for iter in syms-str - collect (format "(%s . %s)" true iter)) - "\n"))))) - - ;;; Custom sequence for testing (cl-defstruct loopy--test-custom-seq @@ -3792,7 +3780,10 @@ are records, which are sequences, so they still work in that way." ;;;;; Final updates (loopy-deftest accumulation-conflicting-final-updates - :doc "Check that commands of the same category but different updates error. + :doc "NOTE: Remove this test when we fully remove `loopy-command-parsers'. +It's already been copied to a version ending in `-ht'. + +Check that commands of the same category but different updates error. Previously, this was mostly concerned with using a different `:result-type' but in the same command type category. @@ -3839,6 +3830,8 @@ expansion time." (loopy--main-body (setq ,var (+ ,var ,val))) (loopy--vars-final-updates (,var . (setq ,var (- ,var 100)))))))) + ;; TODO: Update this for `loopy-parsers' after + ;; `loopy-command-parsers' fully removed. (let ((loopy-command-parsers (thread-first loopy-command-parsers (map-insert 'sum1 @@ -3861,6 +3854,75 @@ expansion time." :iter-keyword (sum1 sum2) :iter-bare t) +(loopy-deftest accumulation-conflicting-final-updates-ht + :doc "Check that commands of the same category but different updates error. + +Previously, this was mostly concerned with using a different +`:result-type' but in the same command type category. + +Wrapping with another eval to make sure variables are set by +expansion time." + :error loopy-incompatible-accumulation-final-updates + :wrap ( + (x . `(cl-labels ((my-loopy-sum-command1 ((&whole cmd _ + var-or-val + &optional + maybe-val)) + "Set TARGET to the sum of ITEMS." + (let ((var) + (val)) + (if maybe-val + (setq var var-or-val + val maybe-val) + (setq var 'loopy-result + val var-or-val)) + (loopy--check-accumulation-compatibility + loopy--loop-name + var 'number cmd) + `((loopy--accumulation-vars (,var nil)) + (loopy--main-body (setq ,var (+ ,var ,val))) + (loopy--vars-final-updates + (,var . (setq ,var (1- ,var))))))) + (my-loopy-sum-command2 ((&whole cmd _ + var-or-val + &optional + maybe-val)) + "Set TARGET to the sum of ITEMS." + (let ((var) + (val)) + (if maybe-val + (setq var var-or-val + val maybe-val) + (setq var 'loopy-result + val var-or-val)) + (loopy--check-accumulation-compatibility + loopy--loop-name + var 'number cmd) + `((loopy--accumulation-vars (,var nil)) + (loopy--main-body (setq ,var (+ ,var ,val))) + (loopy--vars-final-updates + (,var . (setq ,var (- ,var 100)))))))) + ;; TODO: Update this for `loopy-parsers' after + ;; `loopy-command-parsers' fully removed. + (let ((loopy-parsers (thread-first loopy-parsers + (my-ht-map-insert 'sum1 #'my-loopy-sum-command1) + (my-ht-map-insert 'sum2 #'my-loopy-sum-command2))) + (loopy-iter-bare-commands (append '(sum1 sum2) + loopy-iter-bare-commands))) + (eval (quote ,x) t))))) + :multi-body t + :body [((list i '(1 2 3 4 5)) + (sum1 my-target i) + (sum2 my-target i) + (finally-return my-target)) + + ((list i '(1 2 3 4 5)) + (sum1 i) + (sum2 i))] + :loopy t + :iter-keyword (sum1 sum2) + :iter-bare t) + ;;;;; Into Argument (loopy-deftest accumulation-into-argument :doc "Check `:into' works and variable is treated as explicit." @@ -6540,7 +6602,10 @@ Not multiple of 3: 7" ;;; Custom Commands (loopy-deftest custom-command-sum - :doc "Wrapping with another eval to make sure variables are set by expansion time." + :doc "NOTE: Remove this test when we fully remove `loopy-command-parsers'. +It's already been copied to a version ending in `-ht'. + +Wrapping with another eval to make sure variables are set by expansion time." :wrap ((x . `(cl-labels ((my-loopy-sum-command ((_ target &rest items)) "Set TARGET to the sum of ITEMS." `((loopy--iteration-vars (,target nil)) @@ -6559,8 +6624,31 @@ Not multiple of 3: 7" :iter-keyword (target-sum return) :iter-bare ((return . returning))) +(loopy-deftest custom-command-sum-ht + :doc "Wrapping with another eval to make sure variables are set by expansion time." + :wrap ((x . `(cl-labels ((my-loopy-sum-command ((_ target &rest items)) + "Set TARGET to the sum of ITEMS." + `((loopy--iteration-vars (,target nil)) + (loopy--main-body (setq ,target (apply #'+ (list ,@items))))))) + (let ((loopy-parsers (my-ht-map-insert loopy-parsers + 'target-sum + #'my-loopy-sum-command)) + (loopy-iter-bare-commands (cons 'target-sum + loopy-iter-bare-commands))) + (eval (quote ,x) t))))) + :result 6 + :body ((target-sum my-target 1 2 3) + (return nil) + (finally-return my-target)) + :loopy t + :iter-keyword (target-sum return) + :iter-bare ((return . returning))) + (loopy-deftest custom-command-always-pass - :doc "Wrapping with another eval to make sure variables are set by expansion time. + :doc "NOTE: Remove this test when we fully remove `loopy-command-parsers'. +It's already been copied to a version ending in `-ht'. + +Wrapping with another eval to make sure variables are set by expansion time. Also tests that post-conditions work as expected." :wrap ((x . `(cl-labels ((my--loopy-always-command-parser ((_ &rest conditions)) "Parse a command of the form `(my-always [CONDITIONS])'. @@ -6593,12 +6681,47 @@ Otherwise, `loopy' should return t." :iter-bare ((list . listing) (my-always . my-always))) -(loopy-deftest custom-command-always-fail +(loopy-deftest custom-command-always-pass-ht :doc "Wrapping with another eval to make sure variables are set by expansion time. Also tests that post-conditions work as expected." :wrap ((x . `(cl-labels ((my--loopy-always-command-parser ((_ &rest conditions)) "Parse a command of the form `(my-always [CONDITIONS])'. If any condition is `nil', `loopy' should immediately return nil. +Otherwise, `loopy' should return t." + ;; Return t if loop completes successfully. + `((loopy--after-do (cl-return t)) + ;; Check all conditions at the end of the loop + ;; body, forcing an exit if any evaluate to nil. + ;; Since the default return value of the macro is + ;; nil, we don’t need to do anything else. + ;; + ;; NOTE: We must not add anything to + ;; `loopy--final-return', since that would + ;; override the value of any early returns. + ,@(cl-loop + for condition in conditions + collect `(loopy--post-conditions ,condition))))) + (let ((loopy-parsers (my-ht-map-insert loopy-parsers 'my-always #'my--loopy-always-command-parser)) + (loopy-iter-bare-commands (cons 'my-always + loopy-iter-bare-commands))) + (eval (quote ,x) t))))) + :result t + :body ((list i (number-sequence 1 9)) + (my-always (< i 10) (< i 20))) + :loopy t + :iter-keyword (list my-always) + :iter-bare ((list . listing) + (my-always . my-always))) + +(loopy-deftest custom-command-always-fail + :doc "NOTE: Remove this test when we fully remove `loopy-command-parsers'. +It's already been copied to a version ending in `-ht'. + +Wrapping with another eval to make sure variables are set by expansion time. +Also tests that post-conditions work as expected." + :wrap ((x . `(cl-labels ((my--loopy-always-command-parser ((_ &rest conditions)) + "Parse a command of the form `(my-always [CONDITIONS])'. +If any condition is `nil', `loopy' should immediately return nil. Otherwise, `loopy' should return t." ;; Return t if loop completes successfully. `((loopy--after-do (cl-return t)) @@ -6628,6 +6751,39 @@ Otherwise, `loopy' should return t." :iter-bare ((list . listing) (my-always . my-always))) +(loopy-deftest custom-command-always-fail-ht + :doc "Wrapping with another eval to make sure variables are set by expansion time. +Also tests that post-conditions work as expected." + :wrap ((x . `(cl-labels ((my--loopy-always-command-parser ((_ &rest conditions)) + "Parse a command of the form `(my-always [CONDITIONS])'. +If any condition is `nil', `loopy' should immediately return nil. +Otherwise, `loopy' should return t." + ;; Return t if loop completes successfully. + `((loopy--after-do (cl-return t)) + ;; Check all conditions at the end of the loop + ;; body, forcing an exit if any evaluate to nil. + ;; Since the default return value of the macro is + ;; nil, we don’t need to do anything else. + ;; + ;; NOTE: We must not add anything to + ;; `loopy--final-return', since that would + ;; override the value of any early returns. + ,@(cl-loop + for condition in conditions + collect `(loopy--post-conditions ,condition))))) + (let ((loopy-parsers (my-ht-map-insert loopy-parsers 'my-always #'my--loopy-always-command-parser)) + (loopy-iter-bare-commands (cons 'my-always + loopy-iter-bare-commands))) + (eval (quote ,x) t))))) + :result nil + :body ((list i (number-sequence 1 9)) + (list j '(2 4 6 8 9)) + (my-always (< i 10) (cl-evenp j))) + :loopy t + :iter-keyword (list my-always) + :iter-bare ((list . listing) + (my-always . my-always))) + ;;; Repeated evaluation of macro ;; This was an odd case reported by a user. See: @@ -6676,13 +6832,33 @@ This assumes that you're on guix." (set . setting))) ;;; Custom Aliases +(loopy-deftest custom-alias-obsolete-list-array + :doc "Test aliasing to obsolete command names. +NOTE: This should eventually be removed." + :result '((1 . 4) (2 . 5) (3 . 6)) + :wrap ((x . `(let ((loopy-aliases (map-copy loopy-aliases)) + (loopy-iter-bare-commands + (append (list 'my-list2 'my-array2) loopy-iter-bare-commands))) + (loopy-defalias my-list2 in) + (loopy-defalias my-array2 'across) + (eval (quote ,x) + t)))) + :body ((my-list2 i '(1 2 3)) + (my-array2 j [4 5 6]) + (collect (cons i j))) + :loopy t + :iter-keyword (my-list2 my-array2 collect) + :iter-bare ((my-list2 . my-list2) + (my-array2 . my-array2) + (collect . collecting))) + (loopy-deftest custom-alias-flag :doc "Test with `default' flag, which is essentially a no-op." :result '(1) - :wrap ((x . `(let ((loopy-aliases (map-copy loopy-aliases)) + :wrap ((x . `(let ((loopy-parsers + (my-ht-map-insert loopy-parsers 'f (map-elt loopy-parsers 'flag))) (loopy-iter-bare-special-macro-arguments (cons 'f loopy-iter-bare-special-macro-arguments))) - (loopy-defalias f flag) (eval (quote ,x) t)))) :body ((f default) (list i '(1)) @@ -6692,12 +6868,12 @@ This assumes that you're on guix." :iter-bare ((list . listing) (collect . collecting))) + (loopy-deftest custom-alias-with :result 1 - :wrap ((x . `(let ((loopy-aliases (map-copy loopy-aliases)) + :wrap ((x . `(let ((loopy-parsers (my-ht-map-insert loopy-parsers 'as (map-elt loopy-parsers 'with))) (loopy-iter-bare-special-macro-arguments (cons 'as loopy-iter-bare-special-macro-arguments))) - (loopy-defalias as with) (eval (quote ,x) t)))) :body ((as (a 1)) (return a)) @@ -6708,10 +6884,10 @@ This assumes that you're on guix." (loopy-deftest custom-alias-without :result 5 - :wrap ((x . `(let ((loopy-aliases (map-copy loopy-aliases)) + :wrap ((x . `(let ((loopy-parsers + (my-ht-map-insert loopy-parsers 'ignore (map-elt loopy-parsers 'without))) (loopy-iter-bare-special-macro-arguments (cons 'ignore loopy-iter-bare-special-macro-arguments))) - (loopy-defalias ignore without) (eval (quote (let ((a 1) (b 2)) ,x