DEFINE: New command.
authorBen Pfaff <blp@cs.stanford.edu>
Sun, 4 Jul 2021 05:05:35 +0000 (22:05 -0700)
committerBen Pfaff <blp@cs.stanford.edu>
Mon, 5 Jul 2021 01:25:30 +0000 (18:25 -0700)
18 files changed:
NEWS
doc/flow-control.texi
doc/utilities.texi
src/language/command.def
src/language/control/automake.mk
src/language/control/define.c [new file with mode: 0644]
src/language/lexer/automake.mk
src/language/lexer/lexer.c
src/language/lexer/lexer.h
src/language/lexer/macro.c [new file with mode: 0644]
src/language/lexer/macro.h [new file with mode: 0644]
src/language/utilities/title.c
src/libpspp/message.c
src/libpspp/message.h
src/ui/terminal/main.c
tests/automake.mk
tests/language/control/define.at [new file with mode: 0644]
tests/language/lexer/lexer.at

diff --git a/NEWS b/NEWS
index bbf5f877a05d5d6dc1f8695fb0c278c384f5eaf8..6392be56c9e5e1d39a7eadfbb1a674487b05b071 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -6,6 +6,8 @@ Please send PSPP bug reports to bug-gnu-pspp@gnu.org.
 
 Changes from 1.4.1 to 1.5.3:
 
+ * The DEFINE command is now supported.
+
  * An error in the displayed signficance of oneway anova
    contrasts tests has been corrected.
 
index c0931f1bcedca679601d48545da52e0e9f904fab..2a4bd0afae53537c3b402c39615c8526fbc8b3d8 100644 (file)
@@ -20,6 +20,7 @@ looping, and flow of control.
 
 @menu
 * BREAK::                       Exit a loop.
+* DEFINE::                      Define a macro.
 * DO IF::                       Conditionally execute a block of code.
 * DO REPEAT::                   Textually repeat a code block.
 * LOOP::                        Repeat a block of code.
@@ -39,6 +40,799 @@ BREAK.
 @cmd{BREAK} is allowed only inside @cmd{LOOP}@dots{}@cmd{END LOOP}.
 @xref{LOOP}, for more details.
 
+@node DEFINE
+@section DEFINE
+@vindex DEFINE
+@cindex macro
+
+@subsection Overview
+
+@display
+@t{DEFINE} @i{macro_name}@t{(}@r{[}@i{argument}@r{[}@t{/}@i{argument}@r{]@dots{}]}@t{)}
+@dots{}@i{body}@dots{}
+@t{!ENDDEFINE.}
+@end display
+
+Each @i{argument} takes the following form:
+@display
+@r{@{}@i{!arg_name} @t{=},@t{!POSITIONAL}@r{@}}
+@r{[}@t{!DEFAULT(}@i{default}@t{)}@r{]}
+@r{[}@t{!NOEXPAND}@r{]}
+@r{@{}@t{!TOKENS(}@i{count}@t{)},@t{!CHAREND('}@i{token}@t{')},@t{!ENCLOSE('}@i{start}@t{','}@i{end}@t{')},@t{!CMDEND}@}
+@end display
+
+The following directives may be used within @i{body}:
+@example
+!OFFEXPAND
+!ONEXPAND
+@end example
+
+The following functions may be used within the body:
+@display
+@t{!BLANKS(}@i{count}@t{)}
+@t{!CONCAT(}@i{arg}@dots{}@t{)}
+@t{!EVAL(}@i{arg}@t{)}
+@t{!HEAD(}@i{arg}@t{)}
+@t{!INDEX(}@i{haystack}@t{,} @i{needle}@t{)}
+@t{!LENGTH(}@i{arg}@t{)}
+@t{!NULL}
+@t{!QUOTE(}@i{arg}@t{)}
+@t{!SUBSTR(}@i{arg}@t{,} @i{start}[@t{,} @i{count}]@t{)}
+@t{!TAIL(}@i{arg}@t{)}
+@t{!UNQUOTE(}@i{arg}@t{)}
+@t{!UPCASE(}@i{arg}@t{)}
+@end display
+
+The body may also include the following constructs:
+@display
+@t{!IF (}@i{condition}@t{) !THEN} @i{true-expansion} @t{!ENDIF}
+@t{!IF (}@i{condition}@t{) !THEN} @i{true-expansion} @t{!ELSE} @i{false-expansion} @t{!ENDIF}
+
+@t{!DO} @i{!var} @t{=} @i{start} @t{!TO} @i{end} [@t{!BY} @i{step}]
+  @i{body}
+@t{!DOEND}
+@t{!DO} @i{!var} @t{!IN} @t{(}@i{expression}@t{)}
+  @i{body}
+@t{!DOEND}
+
+@t{!LET} @i{!var} @t{=} @i{expression}
+@end display
+
+@subsection Introduction
+
+The DEFINE command creates a @dfn{macro}, which is a name for a
+fragment of PSPP syntax called the macro's @dfn{body}.  Following the
+DEFINE command, syntax may @dfn{call} the macro by name any number of
+times.  Each call substitutes, or @dfn{expands}, the macro's body in
+place of the call, as if the body had been written in its place.
+
+The following syntax defines a macro named @code{!vars} that expands
+to the variable names @code{v1 v2 v3}.  The macro's name begins with
+@samp{!}, which is optional for macro names.  The @code{()} following
+the macro name are required:
+
+@example
+DEFINE !vars()
+v1 v2 v3
+!ENDDEFINE.
+@end example
+
+Here are two ways that @code{!vars} might be called given the
+preceding definition:
+
+@example
+DESCRIPTIVES !vars.
+FREQUENCIES /VARIABLES=!vars.
+@end example
+
+With macro expansion, the above calls are equivalent to the following:
+
+@example
+DESCRIPTIVES v1 v2 v3.
+FREQUENCIES /VARIABLES=v1 v2 v3.
+@end example
+
+The @code{!vars} macro expands to a fixed body.  Macros may have more
+sophisticated contents:
+
+@itemize @bullet
+@item
+Macro @dfn{arguments} that are substituted into the body whenever they
+are named.  The values of a macro's arguments are specified each time
+it is called.  @xref{Macro Arguments}.
+
+@item
+Macro @dfn{functions}, expanded when the macro is called.  @xref{Macro
+Functions}.
+
+@item
+@code{!IF} constructs, for conditional expansion.  @xref{Macro
+Conditional Expansion}.
+
+@item
+Two forms of @code{!DO} construct, for looping over a numerical range
+or a collection of tokens.  @xref{Macro Loops}.
+
+@item
+@code{!LET} constructs, for assigning to macro variables.  @xref{Macro
+Variable Assignment}.
+@end itemize
+
+Many identifiers associated with macros begin with @samp{!}, a
+character not normally allowed in identifiers.  These identifiers are
+reserved only for use with macros, which helps keep them from being
+confused with other kinds of identifiers.
+
+The following sections provide more details on macro syntax and
+semantics.
+
+@node Macro Bodies
+@subsection Macro Bodies
+
+As previously shown, a macro body may contain a fragment of a PSPP
+command (such as a variable name).  A macro body may also contain full
+PSPP commands.  In the latter case, the macro body should also contain
+the command terminators.
+
+Most PSPP commands may occur within a macro.  The @code{DEFINE}
+command itself is one exception, because the inner @code{!ENDDEFINE}
+ends the outer macro definition.  For compatibility, @code{BEGIN
+DATA}@dots{}@code{END DATA.} should not be used within a macro.
+
+The body of a macro may call another macro.  The following shows one
+way that could work:
+
+@example
+DEFINE !commands()
+DESCRIPTIVES !vars.
+FREQUENCIES /VARIABLES=!vars.
+!ENDDEFINE.
+
+DEFINE !vars() v1 v2 v3 !ENDDEFINE.
+!commands
+
+* We can redefine the variables macro to analyze different variables:
+DEFINE !vars() v4 v5 !ENDDEFINE.
+!commands
+@end example
+
+The @code{!commands} macro would be easier to use if it took the
+variables to analyze as an argument rather than through another macro.
+The following section shows how to do that.
+
+@node Macro Arguments
+@subsection Macro Arguments
+
+This section explains how to use macro arguments.  As an initial
+example, the following syntax defines a macro named @code{!analyze}
+that takes all the syntax up to the first command terminator as an
+argument:
+
+@example
+DEFINE !analyze(!POSITIONAL !CMDEND)
+DESCRIPTIVES !1.
+FREQUENCIES /VARIABLES=!1.
+!ENDDEFINE.
+@end example
+
+@noindent When @code{!analyze} is called, it expands to a pair of analysis
+commands with each @code{!1} in the body replaced by the argument.
+That is, these calls:
+
+@example
+!analyze v1 v2 v3.
+!analyze v4 v5.
+@end example
+
+@noindent act like the following:
+
+@example
+DESCRIPTIVES v1 v2 v3.
+FREQUENCIES /VARIABLES=v1 v2 v3.
+DESCRIPTIVES v4 v5.
+FREQUENCIES /VARIABLES=v4 v5.
+@end example
+
+Macros may take any number of arguments, described within the
+parentheses in the DEFINE command.  Arguments come in two varieties
+based on how their values are specified when the macro is called:
+
+@itemize @bullet
+@item
+A @dfn{positional} argument has a required value that follows the
+macro's name.  Use the @code{!POSITIONAL} keyword to declare a
+positional argument.
+
+When a macro is called, every positional argument must be given a
+value in the same order as the defintion.
+
+References to a positional argument in a macro body are numbered:
+@code{!1} is the first positional argument, @code{!2} the second, and
+so on.  In addition, @code{!*} expands to all of the positional
+arguments' values, separated by spaces.
+
+The following example uses a positional argument:
+
+@example
+DEFINE !analyze(!POSITIONAL !CMDEND)
+DESCRIPTIVES !1.
+FREQUENCIES /VARIABLES=!1.
+!ENDDEFINE.
+
+!analyze v1 v2 v3.
+!analyze v4 v5.
+@end example
+
+@item
+A @dfn{keyword} argument has a name.  In the macro call, its value is
+specified with the syntax @code{@i{name}=@i{value}}.  The names allow
+keyword argument values to take any order in the call, and even to be
+omitted.  When one is omitted, a default value is used: either the
+value specified in @code{!DEFAULT(@i{value})}, or an empty value
+otherwise.
+
+In declaration and calls, a keyword argument's name may not begin with
+@samp{!}, but references to it in the macro body do start with a
+leading @samp{!}.
+
+The following example uses a keyword argument that defaults to ALL if
+the argument is not assigned a value:
+
+@example
+DEFINE !analyze_kw(vars=!DEFAULT(ALL) !CMDEND)
+DESCRIPTIVES !vars.
+FREQUENCIES /VARIABLES=!vars.
+!ENDDEFINE.
+
+!analyze_kw vars=v1 v2 v3.  /* Analyze specified variables.
+!analyze_kw.                /* Analyze all variables.
+@end example
+@end itemize
+
+If a macro has both positional and keyword arguments, then the
+positional arguments must come first in the DEFINE command, and their
+values also come first in macro calls.
+
+Each argument declaration specifies the form of its value:
+
+@table @code
+@item !TOKENS(@i{count})
+Exactly @var{count} tokens, e.g.@: @code{!TOKENS(1)} for a single
+token.  Each identifier, number, quoted string, operator, or
+punctuator is a token.  @xref{Tokens}, for a complete definition.
+
+The following variant of @code{!analyze_kw} accepts only a single
+variable name (or @code{ALL}) as its argument:
+
+@example
+DEFINE !analyze_one_var(!POSITIONAL !TOKENS(1))
+DESCRIPTIVES !1.
+FREQUENCIES /VARIABLES=!1.
+!ENDDEFINE.
+
+!analyze_one_var v1.
+@end example
+
+@item !CHAREND('@var{token}')
+Any number of tokens up to @var{token}, which should be an operator or
+punctuator token such as @samp{/} or @samp{+}.  The @var{token} does
+not become part of the value.
+
+With the following variant of @code{!analyze_kw}, the variables must
+be following by @samp{/}:
+
+@example
+DEFINE !analyze_parens(vars=!CHARNED('/'))
+DESCRIPTIVES !vars.
+FREQUENCIES /VARIABLES=!vars.
+!ENDDEFINE.
+
+!analyze_parens vars=v1 v2 v3/.
+@end example
+
+@item !ENCLOSE('@var{start}','@var{end}')
+Any number of tokens enclosed between @var{start} and @var{end}, which
+should each be operator or punctuator tokens.  For example, use
+@code{!ENCLOSE('(',')')} for a value enclosed within parentheses.
+(Such a value could never have right parentheses inside it, even
+paired with left parentheses.)  The start and end tokens are not part
+of the value.
+
+With the following variant of @code{!analyze_kw}, the variables must
+be specified within parentheses:
+
+@example
+DEFINE !analyze_parens(vars=!ENCLOSE('(',')'))
+DESCRIPTIVES !vars.
+FREQUENCIES /VARIABLES=!vars.
+!ENDDEFINE.
+
+!analyze_parens vars=(v1 v2 v3).
+@end example
+
+@item !CMDEND
+Any number of tokens up to the end of the command.  This should be
+used only for the last positional parameter, since it consumes all of
+the tokens in the command calling the macro.
+
+The following variant of @code{!analyze_kw} takes all the variable
+names up to the end of the command as its argument:
+
+@example
+DEFINE !analyze_kw(vars=!CMDEND)
+DESCRIPTIVES !vars.
+FREQUENCIES /VARIABLES=!vars.
+!ENDDEFINE.
+
+!analyze_kw vars=v1 v2 v3.
+@end example
+@end table
+
+By default, when an argument's value contains a macro call, the call
+is expanded each time the argument appears in the macro's body.  The
+@code{!NOEXPAND} keyword in an argument declaration suppresses this
+expansion.  @xref{Controlling Macro Expansion}.
+
+@node Controlling Macro Expansion
+@subsection Controlling Macro Expansion
+
+Multiple factors control whether macro calls are expanded in different
+situations.  At the highest level, @code{SET MEXPAND} controls whether
+macro calls are expanded.  By default, it is enabled.  @xref{SET
+MEXPAND}, for details.
+
+A macro body may contain macro calls.  By default, these are expanded.
+If a macro body contains @code{!OFFEXPAND} or @code{!ONEXPAND}
+directives, then @code{!OFFEXPAND} disables expansion of macro calls
+until the following @code{!ONEXPAND}.
+
+A macro argument's value may contain a macro call.  These macro calls
+are expanded, unless the argument was declared with the
+@code{!NOEXPAND} keyword.
+
+The argument to a macro function is a special context that does not
+expand macro calls.  For example, if @code{!vars} is the name of a
+macro, then @code{!LENGTH(!vars)} expands to 5, as does
+@code{!LENGTH(!1)} if positional argument 1 has value @code{!vars}.
+To expand macros in these cases, use the @code{!EVAL} macro function,
+e.g.@: @code{!LENGTH(!EVAL(!vars))} or @code{!LENGTH(!EVAL(!1))}.
+@xref{Macro Functions}, for details.
+
+These rules apply to macro calls, not to uses of macro functions and
+macro arguments within a macro body, which are always expanded.
+
+@node Macro Functions
+@subsection Macro Functions
+
+Macro bodies may manipulate syntax using macro functions.  Macro
+functions accept tokens as arguments and expand to sequences of
+characters.
+
+The arguments to macro functions have a restricted form.  They may
+only be a single token (such as an identifier or a string), a macro
+argument, or a call to a macro function.  Thus, the following are
+valid macro arguments:
+@example
+x    5.0    x    !1    "5 + 6"    !CONCAT(x,y)
+@end example
+@noindent and the following are not:
+@example
+x y    5+6
+@end example
+
+Macro functions expand to sequences of characters.  When these
+character strings are processed further as character strings, e.g.@:
+with @code{!LENGTH}, any character string is valid.  When they are
+interpreted as PSPP syntax, e.g.@: when the expansion becomes part of
+a command, they need to be valid for that purpose.  For example,
+@code{!UNQUOTE("It's")} will yield an error if the expansion
+@code{It's} becomes part of a PSPP command, because it contains
+unbalanced single quotes, but @code{!LENGTH(!UNQUOTE("It's"))} expands
+to 4.
+
+The following macro functions are available.  Each function's
+documentation includes examples in the form @code{@var{call}
+@expansion{} @var{expansion}}.
+
+@deffn {Macro Function} !BLANKS (count)
+Expands to @var{count} unquoted spaces, where @var{count} is a
+nonnegative integer.  Outside quotes, any positive number of spaces
+are equivalent; for a quoted string of spaces, use
+@code{!QUOTE(!BLANKS(@var{count}))}.
+
+In the examples below, @samp{_} stands in for a space to make the
+results visible.
+
+@c Keep these examples in sync with the test for !BLANKS in
+@c tests/language/control/define.at:
+@example
+!BLANKS(0)                  @expansion{} @r{empty}
+!BLANKS(1)                  @expansion{} _
+!BLANKS(2)                  @expansion{} __
+!QUOTE(!BLANKS(5))          @expansion{} '_____'
+@end example
+@end deffn
+
+@deffn {Macro Function} !CONCAT (arg@dots{})
+Expands to the concatenation of all of the arguments.  Before
+concatenation, each quoted string argument is unquoted, as if
+@code{!UNQUOTE} were applied.  This allows for ``token pasting'',
+combining two (or more) tokens into a single one:
+
+@c Keep these examples in sync with the test for !CONCAT in
+@c tests/language/control/define.at:
+@example
+!CONCAT(x, y)                @expansion{} xy
+!CONCAT('x', 'y')            @expansion{} xy
+!CONCAT(12, 34)              @expansion{} 1234
+!CONCAT(!NULL, 123)          @expansion{} 123
+@end example
+
+@code{!CONCAT} is often used for constructing a series of similar
+variable names from a prefix followed by a number and perhaps a
+suffix.  For example:
+
+@c Keep these examples in sync with the test for !CONCAT in
+@c tests/language/control/define.at:
+@example
+!CONCAT(x, 0)                @expansion{} x0
+!CONCAT(x, 0, y)             @expansion{} x0y
+@end example
+
+An identifier token must begin with a letter (or @samp{#} or
+@samp{@@}), which means that attempting to use a number as the first
+part of an identifier will produce a pair of distinct tokens rather
+than a single one.  For example:
+
+@c Keep these examples in sync with the test for !CONCAT in
+@c tests/language/control/define.at:
+@example
+!CONCAT(0, x)                @expansion{} 0 x
+!CONCAT(0, x, y)             @expansion{} 0 xy
+@end example
+@end deffn
+
+@deffn {Macro Function} !EVAL (arg)
+Expands macro calls in @var{arg}.  This is especially useful if
+@var{arg} is the name of a macro or a macro argument that expands to
+one, because arguments to macro functions are not expanded by default
+(@pxref{Controlling Macro Expansion}).
+
+The following examples assume that @code{!vars} is a macro that
+expands to @code{a b c}:
+
+@example
+!vars                        @expansion{} a b c
+!QUOTE(!vars)                @expansion{} '!vars'
+!EVAL(!vars)                 @expansion{} a b c
+!QUOTE(!EVAL(!vars))         @expansion{} 'a b c'
+@end example
+
+These examples additionally assume that argument @code{!1} has value
+@code{!vars}:
+
+@example
+!1                           @expansion{} a b c
+!QUOTE(!1)                   @expansion{} '!vars'
+!EVAL(!1)                    @expansion{} a b c
+!QUOTE(!EVAL(!1))            @expansion{} 'a b c'
+@end example
+@end deffn
+
+@deffn {Macro Function} !HEAD (arg)
+@deffnx {Macro Function} !TAIL (arg)
+@code{!HEAD} expands to just the first token in an unquoted version of
+@var{arg}, and @code{!TAIL} to all the tokens after the first.
+
+@example
+!HEAD('a b c')               @expansion{} a
+!HEAD('a')                   @expansion{} a
+!HEAD(!NULL)                 @expansion{} @r{empty}
+!HEAD('')                    @expansion{} @r{empty}
+
+!TAIL('a b c')               @expansion{} b c
+!TAIL('a')                   @expansion{} @r{empty}
+!TAIL(!NULL)                 @expansion{} @r{empty}
+!TAIL('')                    @expansion{} @r{empty}
+@end example
+@end deffn
+
+@deffn {Macro Function} !INDEX (haystack, needle)
+Looks for @var{needle} in @var{haystack}.  If it is present, expands
+to the 1-based index of its first occurrence; if not, expands to 0.
+
+@example
+!INDEX(banana, an)           @expansion{} 2
+!INDEX(banana, nan)          @expansion{} 3
+!INDEX(banana, apple)        @expansion{} 0
+!INDEX("banana", nan)        @expansion{} 4
+!INDEX("banana", "nan")      @expansion{} 0
+!INDEX(!UNQUOTE("banana"), !UNQUOTE("nan")) @expansion{} 3
+@end example
+@end deffn
+
+@deffn {Macro Function} !LENGTH (arg)
+Expands to a number token representing the number of characters in
+@var{arg}.
+
+@example
+!LENGTH(123)                 @expansion{} 3
+!LENGTH(123.00)              @expansion{} 6
+!LENGTH( 123 )               @expansion{} 3
+!LENGTH("123")               @expansion{} 5
+!LENGTH(xyzzy)               @expansion{} 5
+!LENGTH("xyzzy")             @expansion{} 7
+!LENGTH("xy""zzy")           @expansion{} 9
+!LENGTH(!UNQUOTE("xyzzy"))   @expansion{} 5
+!LENGTH(!UNQUOTE("xy""zzy")) @expansion{} 6
+!LENGTH(!1)                  @expansion{} 5 @r{if @t{!1} is @t{a b c}}
+!LENGTH(!1)                  @expansion{} 0 @r{if @t{!1} is empty}
+!LENGTH(!NULL)               @expansion{} 0
+@end example
+@end deffn
+
+@deffn {Macro Function} !NULL
+Expands to an empty character sequence.
+
+@example
+!NULL                        @expansion{} @r{empty}
+!QUOTE(!NULL)                @expansion{} ''
+@end example
+@end deffn
+
+@deffn {Macro Function} !QUOTE (arg)
+@deffnx {Macro Function} !UNQUOTE (arg)
+The @code{!QUOTE} function expands to its argument surrounded by
+apostrophes, doubling any apostrophes inside the argument to make sure
+that it is valid PSPP syntax for a string.  If the argument was
+already a quoted string, @code{!QUOTE} expands to it unchanged.
+
+Given a quoted string argument, the @code{!UNQUOTED} function expands
+to the string's contents, with the quotes removed and any doubled
+quote marks reduced to singletons.  If the argument was not a quoted
+string, @code{!UNQUOTE} expands to the argument unchanged.
+
+@example
+!QUOTE(123.0)                @expansion{} '123.0'
+!QUOTE( 123 )                @expansion{} '123'
+!QUOTE('a b c')              @expansion{} 'a b c'
+!QUOTE("a b c")              @expansion{} "a b c"
+!QUOTE(!1)                   @expansion{} 'a ''b'' c' @r{if @t{!1} is @t{a 'b' c}}
+
+!UNQUOTE(123.0)              @expansion{} 123.0
+!UNQUOTE( 123 )              @expansion{} 123
+!UNQUOTE('a b c')            @expansion{} a b c
+!UNQUOTE("a b c")            @expansion{} a b c
+!UNQUOTE(!1)                 @expansion{} a 'b' c @r{if @t{!1} is @t{a 'b' c}}
+
+!QUOTE(!UNQUOTE(123.0))      @expansion{} '123.0'
+!QUOTE(!UNQUOTE( 123 ))      @expansion{} '123'
+!QUOTE(!UNQUOTE('a b c'))    @expansion{} 'a b c'
+!QUOTE(!UNQUOTE("a b c"))    @expansion{} 'a b c'
+!QUOTE(!UNQUOTE(!1))         @expansion{} 'a ''b'' c' @r{if @t{!1} is @t{a 'b' c}}
+@end example
+@end deffn
+
+@deffn {Macro Function} !SUBSTR (arg, start[, count])
+Expands to a substring of @var{arg} starting from 1-based position
+@var{start}.  If @var{count} is given, it limits the number of
+characters in the expansion; if it is omitted, then the expansion
+extends to the end of @var{arg}.
+
+@example
+!SUBSTR(banana, 3)           @expansion{} nana
+!SUBSTR(banana, 3, 3)        @expansion{} nan
+!SUBSTR("banana", 1, 3)         @expansion{} @r{error (@code{"ba} is not a valid token)}
+!SUBSTR(!UNQUOTE("banana"), 3) @expansion{} nana
+!SUBSTR("banana", 3, 3)      @expansion{} ana
+
+!SUBSTR(banana, 3, 0)        @expansion{} @r{empty}
+!SUBSTR(banana, 3, 10)       @expansion{} nana
+!SUBSTR(banana, 10, 3)       @expansion{} @r{empty}
+@end example
+@end deffn
+
+@deffn {Macro Function} !UPCASE (arg)
+Expands to an unquoted version of @var{arg} with all letters converted
+to uppercase.
+
+@example
+!UPCASE(freckle)             @expansion{} FRECKLE
+!UPCASE('freckle')           @expansion{} FRECKLE
+!UPCASE('a b c')             @expansion{} A B C
+!UPCASE('A B C')             @expansion{} A B C
+@end example
+@end deffn
+
+@node Macro Expressions
+@subsection Macro Expressions
+
+Macro expressions are used in conditional expansion and loops, which
+are described in the following sections.  A macro expression may use
+the following operators, listed in descending order of operator
+precedence:
+
+@table @code
+@item ()
+Parentheses override the default operator precedence.
+
+@item !EQ !NE !GT !LT !GE !LE = ~= <> > < >= <=
+Relational operators compare their operands and yield a Boolean
+result, either @samp{0} for false or @samp{1} for true.
+
+These operators always compare their operands as strings.  This can be
+surprising when the strings are numbers because, e.g.,@: @code{1 <
+1.0} and @code{10 < 2} both evaluate to @samp{1} (true).
+
+Comparisons are case sensitive, so that @code{a = A} evaluates to
+@samp{0} (false).
+
+@item !NOT ~
+@itemx !AND &
+@itemx !OR |
+Logical operators interpret their operands as Boolean values, where
+quoted or unquoted @samp{0} is false and anything else is true, and
+yield a Boolean result, either @samp{0} for false or @samp{1} for
+true.
+@end table
+
+Macro expressions do not include any arithmetic operators.
+
+An operand in an expression may be a single token (including a macro
+argument name) or a macro function invocation.  Either way, the
+expression evaluator unquotes the operand, so that @code{1 = '1'} is
+true.
+
+@node Macro Conditional Expansion
+@subsection Macro Conditional Expansion
+
+The @code{!IF} construct may be used inside a macro body to allow for
+conditional expansion.  It takes the following forms:
+
+@example
+!IF (@var{expression}) !THEN @var{true-expansion} !IFEND
+!IF (@var{expression}) !THEN @var{true-expansion} !ELSE @var{false-expansion} !IFEND
+@end example
+
+When @var{expression} evaluates to true, the macro processor expands
+@var{true-expansion}; otherwise, it expands @var{false-expansion}, if
+it is present.  The macro processor considers quoted or unquoted
+@samp{0} to be false, and anything else to be true.
+
+@node Macro Loops
+@subsection Macro Loops
+
+The body of a macro may include two forms of loops: loops over
+numerical ranges and loops over tokens.  Both forms expand a @dfn{loop
+body} multiple times, each time setting a named @dfn{loop variable} to
+a different value.  The loop body typically expands the loop variable
+at least once.
+
+The MITERATE setting (@pxref{SET MITERATE}) limits the number of
+iterations in a loop.  This is a safety measure to ensure that macro
+expansion terminates.  PSPP issues a warning when the MITERATE limit
+is exceeded.
+
+@subsubheading Loops Over Ranges
+
+@example
+!DO @var{!var} = @var{start} !TO @var{end} [!BY @var{step}]
+  @var{body}
+!DOEND
+@end example
+
+A loop over a numerical range has the form shown above.  @var{start},
+@var{end}, and @var{step} (if included) must be expressions with
+numeric values.  The macro processor accepts both integers and real
+numbers.  The macro processor expands @var{body} for each numeric
+value from @var{start} to @var{end}, inclusive.
+
+The default value for @var{step} is 1.  If @var{step} is positive and
+@math{@var{first} > @var{last}}, or if @var{step} is negative and
+@math{@var{first} < @var{last}}, then the macro processor doesn't
+expand the body at all.  @var{step} may not be zero.
+
+@subsubheading Loops Over Tokens
+
+@example
+!DO @var{!var} !IN (@var{expression})
+  @var{body}
+!DOEND
+@end example
+
+A loop over tokens takes the form shown above.  The macro processor
+evaluates @var{expression} and expands @var{body} once per token in
+the result, substituting the token for @var{!var} each time it
+appears.
+
+@node Macro Variable Assignment
+@subsection Macro Variable Assignment
+
+The @code{!LET} construct evaluates an expression and assigns the
+result to a macro variable.  It may create a new macro variable or
+change the value of one created by a previous @code{!LET} or
+@code{!DO}, but it may not change the value of a macro argument.
+@code{!LET} has the following form:
+
+@example
+!LET @var{!var} = @var{expression}
+@end example
+
+If @var{expression} is more than one token, it must be enclosed in
+parentheses.
+
+@node Macro Settings
+@subsection Macro Settings
+
+Some macro behavior is controlled through the SET command
+(@pxref{SET}).  This section describes these settings.
+
+Any SET command that changes these settings within a macro body only
+takes effect following the macro.  This is because PSPP expands a
+macro's entire body at once, so that the SET command inside the body
+only executes afterwards.
+
+The MEXPAND setting (@pxref{SET MEXPAND}) controls whether macros will
+be expanded at all.  By default, macro expansion is on.  To avoid
+expansion of macros called within a macro body, use @code{!OFFEXPAND}
+and @code{!ONEXPAND} (@pxref{Controlling Macro Expansion}).
+
+When MPRINT (@pxref{SET MPRINT}) is turned on, PSPP outputs an
+expansion of each macro called.  This feature can be useful for
+debugging macro definitions.  For reading the expanded version, note
+that macro expansion removes comments and standardizes white space.
+
+MNEST (@pxref{SET MNEST}) limits the depth of expansion of macro
+calls, that is, the nesting level of macro expansion.  The default is
+50.  This is mainly useful to avoid infinite expansion in the case of
+a macro that calls itself.
+
+MITERATE (@pxref{SET MITERATE}) limits the number of iterations in a
+@code{!DO} construct.  The default is 1000.
+
+PRESERVE...RESTORE
+
+SET MEXPAND, etc. doesn't work inside macro bodies.
+
+@node Macro Notes
+@subsection Additional Notes
+
+@subsubsection Command Terminators
+
+Macros and command terminators require care.  Macros honor the syntax
+differences between interactive and batch syntax (@pxref{Syntax
+Variants}), which means that the interpretation of a macro can vary
+depending on the syntax mode in use.  We assume here that interactive
+mode is in use, in which @samp{.}@: at the end of a line is the
+primary way to end a command.
+
+The @code{DEFINE} command needs to end with @samp{.}@: following the
+@code{!ENDDEFINE}.  The macro body may contain @samp{.}@: if it is
+intended to expand to whole commands, but using @samp{.}@: within a
+macro body that expands to just syntax fragments (such as a list of
+variables) will cause syntax errors.
+
+Macro directives such as @code{!IF} and @code{!DO} do not end with
+@samp{.}.
+
+@subsubsection Expansion Contexts
+
+Macros do not expand within comments, whether introduced within a line
+by @code{/*} or as a separate COMMENT or @samp{*} commands
+(@pxref{COMMENT}).  (SPSS does expand macros in COMMENT and @samp{*}.)
+
+Macros do not expand within quoted strings.
+
+Macros are expanded in the @code{TITLE} and @code{SUBTITLE} commands
+as long as their arguments are not quoted strings.
+
+@subsubsection PRESERVE and RESTORE
+
+Some macro bodies might use the SET command to change certain
+settings.  When this is the case, consider using the PRESERVE and
+RESTORE commands to save and then restore these settings.
+@xref{PRESERVE and RESTORE}.
+
 @node DO IF
 @section DO IF
 @vindex DO IF
index da5de1ddceaf5164c80cd8788b6f65a921c40d14..bd5b10c9e2bebe0699ccfc408e875fb94d3e55d5 100644 (file)
@@ -938,21 +938,25 @@ The following subcommands affect the interpretation of macros.
 
 @table @asis
 @item MEXPAND
+@anchor{SET MEXPAND}
 Controls whether macros are expanded.  The default is ON.
 
 @item MPRINT
+@anchor{SET MPRINT}
 Controls whether the expansion of macros is included in output.  This
 is separate from whether command syntax in general is included in
 output.  The default is OFF.
 
 @item MITERATE
+@anchor{SET MITERATE}
 Limits the number of iterations executed in @code{!DO} loops within
 macros.  This does not affect other language constructs such as
 @cmd{LOOP}.  This must be set to a positive integer.  The default is
 1000.
 
 @item MNEST
-Limits the number of levels of nested macro expansion.  This must be
+@anchor{SET MNEST}
+Limits the number of levels of nested macro expansions.  This must be
 set to a positive integer.  The default is 50.
 @end table
 
index a97f9b83e70fd1c7e021188eb6a84107a6c04627..63df224bde598e249819da9ad500f81207e2fbb0 100644 (file)
@@ -18,6 +18,7 @@
 DEF_CMD (S_ANY, F_ENHANCED, "CLOSE FILE HANDLE", cmd_close_file_handle)
 DEF_CMD (S_ANY, 0, "CACHE", cmd_cache)
 DEF_CMD (S_ANY, 0, "CD", cmd_cd)
+DEF_CMD (S_ANY, 0, "DEFINE", cmd_define)
 DEF_CMD (S_ANY, 0, "DO REPEAT", cmd_do_repeat)
 DEF_CMD (S_ANY, 0, "END REPEAT", cmd_end_repeat)
 DEF_CMD (S_ANY, 0, "ECHO", cmd_echo)
@@ -154,6 +155,7 @@ DEF_CMD (S_INPUT_PROGRAM, 0, "END INPUT PROGRAM", cmd_end_input_program)
 DEF_CMD (S_INPUT_PROGRAM, 0, "REREAD", cmd_reread)
 
 /* Commands for testing PSPP. */
+DEF_CMD (S_ANY, F_TESTING, "DEBUG EXPAND", cmd_debug_expand)
 DEF_CMD (S_ANY, F_TESTING, "DEBUG EVALUATE", cmd_debug_evaluate)
 DEF_CMD (S_ANY, F_TESTING, "DEBUG FORMAT GUESSER", cmd_debug_format_guesser)
 DEF_CMD (S_ANY, F_TESTING, "DEBUG MOMENTS", cmd_debug_moments)
@@ -188,7 +190,6 @@ UNIMPL_CMD ("CSTABULATE", "Tabulate complex samples")
 UNIMPL_CMD ("CTABLES", "Display complex samples")
 UNIMPL_CMD ("CURVEFIT", "Fit curve to line plot")
 UNIMPL_CMD ("DATE", "Create time series data")
-UNIMPL_CMD ("DEFINE", "Syntax macros")
 UNIMPL_CMD ("DETECTANOMALY", "Find unusual cases")
 UNIMPL_CMD ("DISCRIMINANT", "Linear discriminant analysis")
 UNIMPL_CMD ("EDIT", "obsolete")
index 909acd13db4106bfd0872a265bbb02397e11d3bc..9d09687c81e38330552f5f23c5d6f3b01385edf4 100644 (file)
@@ -20,6 +20,7 @@
 language_control_sources = \
        src/language/control/control-stack.c \
        src/language/control/control-stack.h \
+       src/language/control/define.c \
        src/language/control/do-if.c \
        src/language/control/loop.c \
        src/language/control/repeat.c \
diff --git a/src/language/control/define.c b/src/language/control/define.c
new file mode 100644 (file)
index 0000000..3a7f535
--- /dev/null
@@ -0,0 +1,268 @@
+/* PSPP - a program for statistical analysis.
+   Copyright (C) 2021 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+#include <limits.h>
+
+#include "language/command.h"
+#include "language/lexer/lexer.h"
+#include "language/lexer/macro.h"
+#include "language/lexer/scan.h"
+#include "language/lexer/token.h"
+#include "libpspp/message.h"
+
+#include "gl/xalloc.h"
+
+#include "gettext.h"
+#define _(msgid) gettext (msgid)
+
+static bool
+force_macro_id (struct lexer *lexer)
+{
+  return lex_token (lexer) == T_MACRO_ID || lex_force_id (lexer);
+}
+
+static bool
+match_macro_id (struct lexer *lexer, const char *keyword)
+{
+  if (keyword[0] != '!')
+    return lex_match_id (lexer, keyword);
+  else if (lex_token (lexer) == T_MACRO_ID
+           && lex_id_match_n (ss_cstr (keyword), lex_tokss (lexer), 4))
+    {
+      lex_get (lexer);
+      return true;
+    }
+  else
+    return false;
+}
+
+/* Obtains a quoted string from LEXER and then tokenizes the quoted string's
+   content to obtain a single TOKEN.  Returns true if successful, false
+   otherwise.  The caller takes ownership of TOKEN on success, otherwise TOKEN
+   is indeterminate. */
+static bool
+parse_quoted_token (struct lexer *lexer, struct token *token)
+{
+  if (!lex_force_string (lexer))
+    return false;
+
+  struct substring s = lex_tokss (lexer);
+  struct string_lexer slex;
+  string_lexer_init (&slex, s.string, s.length, SEG_MODE_INTERACTIVE, true);
+  struct token another_token = { .type = T_STOP };
+  if (!string_lexer_next (&slex, token)
+      || string_lexer_next (&slex, &another_token))
+    {
+      token_uninit (token);
+      token_uninit (&another_token);
+      lex_error (lexer, _("String must contain exactly one token."));
+      return false;
+    }
+  lex_get (lexer);
+  return true;
+}
+
+int
+cmd_define (struct lexer *lexer, struct dataset *ds UNUSED)
+{
+  if (!force_macro_id (lexer))
+    return CMD_FAILURE;
+
+  /* Parse macro name. */
+  struct macro *m = xmalloc (sizeof *m);
+  *m = (struct macro) {
+    .name = ss_xstrdup (lex_tokss (lexer)),
+    .file_name = xstrdup_if_nonnull (lex_get_file_name (lexer)),
+    .first_line = lex_get_first_line_number (lexer, 0),
+  };
+  lex_get (lexer);
+
+  if (!lex_force_match (lexer, T_LPAREN))
+    goto error;
+
+  size_t allocated_params = 0;
+  while (!lex_match (lexer, T_RPAREN))
+    {
+      if (m->n_params >= allocated_params)
+        m->params = x2nrealloc (m->params, &allocated_params,
+                                sizeof *m->params);
+
+      size_t param_index = m->n_params++;
+      struct macro_param *p = &m->params[param_index];
+      *p = (struct macro_param) { .expand_arg = true };
+
+      /* Parse parameter name. */
+      if (match_macro_id (lexer, "!POSITIONAL"))
+        {
+          if (param_index > 0 && !m->params[param_index - 1].positional)
+            {
+              lex_error (lexer, _("Positional parameters must precede "
+                                  "keyword parameters."));
+              goto error;
+            }
+
+          p->positional = true;
+          p->name = xasprintf ("!%zu", param_index + 1);
+        }
+      else
+        {
+          if (lex_token (lexer) == T_MACRO_ID)
+            {
+              lex_error (lexer, _("Keyword macro parameter must be named in "
+                                  "definition without \"!\" prefix."));
+              goto error;
+            }
+          if (!lex_force_id (lexer))
+            goto error;
+
+          if (is_macro_keyword (lex_tokss (lexer)))
+            {
+              lex_error (lexer, _("Cannot use macro keyword \"%s\" "
+                                  "as an argument name."),
+                         lex_tokcstr (lexer));
+              goto error;
+            }
+
+          p->positional = false;
+          p->name = xasprintf ("!%s", lex_tokcstr (lexer));
+          lex_get (lexer);
+
+          if (!lex_force_match (lexer, T_EQUALS))
+            goto error;
+        }
+
+      /* Parse default value. */
+      if (match_macro_id (lexer, "!DEFAULT"))
+        {
+          if (!lex_force_match (lexer, T_LPAREN))
+            goto error;
+
+          /* XXX Should this handle balanced inner parentheses? */
+          while (!lex_match (lexer, T_RPAREN))
+            {
+              if (lex_token (lexer) == T_ENDCMD)
+                {
+                  lex_error_expecting (lexer, ")");
+                  goto error;
+                }
+              char *syntax = lex_next_representation (lexer, 0, 0);
+              const struct macro_token mt = {
+                .token = *lex_next (lexer, 0),
+                .syntax = ss_cstr (syntax),
+              };
+              macro_tokens_add (&p->def, &mt);
+              free (syntax);
+
+              lex_get (lexer);
+            }
+        }
+
+      if (match_macro_id (lexer, "!NOEXPAND"))
+        p->expand_arg = false;
+
+      if (match_macro_id (lexer, "!TOKENS"))
+        {
+          if (!lex_force_match (lexer, T_LPAREN)
+              || !lex_force_int_range (lexer, "!TOKENS", 1, INT_MAX))
+            goto error;
+          p->arg_type = ARG_N_TOKENS;
+          p->n_tokens = lex_integer (lexer);
+          lex_get (lexer);
+          if (!lex_force_match (lexer, T_RPAREN))
+            goto error;
+        }
+      else if (match_macro_id (lexer, "!CHAREND"))
+        {
+          p->arg_type = ARG_CHAREND;
+          p->charend = (struct token) { .type = T_STOP };
+
+          if (!lex_force_match (lexer, T_LPAREN)
+              || !parse_quoted_token (lexer, &p->charend)
+              || !lex_force_match (lexer, T_RPAREN))
+            goto error;
+        }
+      else if (match_macro_id (lexer, "!ENCLOSE"))
+        {
+          p->arg_type = ARG_ENCLOSE;
+          p->enclose[0] = p->enclose[1] = (struct token) { .type = T_STOP };
+
+          if (!lex_force_match (lexer, T_LPAREN)
+              || !parse_quoted_token (lexer, &p->enclose[0])
+              || !lex_force_match (lexer, T_COMMA)
+              || !parse_quoted_token (lexer, &p->enclose[1])
+              || !lex_force_match (lexer, T_RPAREN))
+            goto error;
+        }
+      else if (match_macro_id (lexer, "!CMDEND"))
+        p->arg_type = ARG_CMDEND;
+      else
+        {
+          lex_error_expecting (lexer, "!TOKENS", "!CHAREND",
+                               "!ENCLOSE", "!CMDEND");
+          goto error;
+        }
+
+      if (lex_token (lexer) != T_RPAREN && !lex_force_match (lexer, T_SLASH))
+        goto error;
+    }
+
+  struct string body = DS_EMPTY_INITIALIZER;
+  while (!match_macro_id (lexer, "!ENDDEFINE"))
+    {
+      if (lex_token (lexer) != T_STRING)
+        {
+          lex_error (lexer, _("Expecting macro body or !ENDDEFINE"));
+          ds_destroy (&body);
+          goto error;
+        }
+
+      ds_put_substring (&body, lex_tokss (lexer));
+      ds_put_byte (&body, '\n');
+      lex_get (lexer);
+    }
+  m->last_line = lex_get_last_line_number (lexer, 0);
+
+  macro_tokens_from_string (&m->body, body.ss, lex_get_syntax_mode (lexer));
+  ds_destroy (&body);
+
+  lex_define_macro (lexer, m);
+
+  return CMD_SUCCESS;
+
+error:
+  macro_destroy (m);
+  return CMD_FAILURE;
+}
+
+int
+cmd_debug_expand (struct lexer *lexer, struct dataset *ds UNUSED)
+{
+  settings_set_mprint (true);
+
+  while (lex_token (lexer) != T_STOP)
+    {
+      if (!lex_next_is_from_macro (lexer, 0) && lex_token (lexer) != T_ENDCMD)
+        {
+          char *rep = lex_next_representation (lexer, 0, 0);
+          msg (MN, "unexpanded token \"%s\"", rep);
+          free (rep);
+        }
+      lex_get (lexer);
+    }
+  return CMD_SUCCESS;
+}
index 4387c3dd223b77e879a57b99bfc3541100ee7475..01b3df49c6cb62745a2df2902110a9f652766777 100644 (file)
@@ -24,6 +24,8 @@ language_lexer_sources = \
        src/language/lexer/include-path.h \
        src/language/lexer/lexer.c \
        src/language/lexer/lexer.h \
+       src/language/lexer/macro.c \
+       src/language/lexer/macro.h \
        src/language/lexer/format-parser.c \
        src/language/lexer/format-parser.h \
        src/language/lexer/scan.c \
index 21309f5f975f688693e0ea09534cd750cf29dab9..bc031189fbcd6c4b56562d9446de4ab846b10d50 100644 (file)
@@ -31,6 +31,7 @@
 #include <uniwidth.h>
 
 #include "language/command.h"
+#include "language/lexer/macro.h"
 #include "language/lexer/scan.h"
 #include "language/lexer/segment.h"
 #include "language/lexer/token.h"
@@ -61,14 +62,43 @@ struct lex_token
     /* The regular token information. */
     struct token token;
 
-    /* Location of token in terms of the lex_source's buffer.
+    /* For a token obtained through the lexer in an ordinary way, this is the
+       location of the token in terms of the lex_source's buffer.
+
+       For a token produced through macro expansion, this is the entire macro
+       call.
+
        src->tail <= line_pos <= token_pos <= src->head. */
     size_t token_pos;           /* Start of token. */
     size_t token_len;           /* Length of source for token in bytes. */
     size_t line_pos;            /* Start of line containing token_pos. */
     int first_line;             /* Line number at token_pos. */
+
+    /* For a token obtained through macro expansion, this is just this token.
+
+       For a token obtained through the lexer in an ordinary way, these are
+       nulls and zeros. */
+    char *macro_rep;        /* The whole macro expansion. */
+    size_t ofs;             /* Offset of this token in macro_rep. */
+    size_t len;             /* Length of this token in macro_rep. */
+    size_t *ref_cnt;        /* Number of lex_tokens that refer to macro_rep. */
   };
 
+static void
+lex_token_uninit (struct lex_token *t)
+{
+  token_uninit (&t->token);
+  if (t->ref_cnt)
+    {
+      assert (*t->ref_cnt > 0);
+      if (!--*t->ref_cnt)
+        {
+          free (t->macro_rep);
+          free (t->ref_cnt);
+        }
+    }
+}
+
 /* A source of tokens, corresponding to a syntax file.
 
    This is conceptually a lex_reader wrapped with everything needed to convert
@@ -77,6 +107,7 @@ struct lex_source
   {
     struct ll ll;               /* In lexer's list of sources. */
     struct lex_reader *reader;
+    struct lexer *lexer;
     struct segmenter segmenter;
     bool eof;                   /* True if T_STOP was read from 'reader'. */
 
@@ -94,28 +125,45 @@ struct lex_source
     int n_newlines;             /* Number of new-lines up to seg_pos. */
     bool suppress_next_newline;
 
-    /* Tokens. */
-    struct deque deque;         /* Indexes into 'tokens'. */
-    struct lex_token *tokens;   /* Lookahead tokens for parser. */
+    /* Tokens.
+
+       This is mostly like a deque, with the invariant that 'back <= middle <=
+       front' (modulo SIZE_MAX+1).  The tokens available for parsing are
+       between 'back' and 'middle': the token at 'back' is the current token,
+       the token at 'back + 1' is the next token, and so on.  There are usually
+       no tokens between 'middle' and 'front'; if there are, then they need to
+       go through macro expansion and are not yet available for parsing.
+
+       'capacity' is the current number of elements in 'tokens'.  It is always
+       a power of 2.  'front', 'middle', and 'back' refer to indexes in
+       'tokens' modulo 'capacity'. */
+    size_t front;
+    size_t middle;
+    size_t back;
+    size_t capacity;
+    size_t mask;                /* capacity - 1 */
+    struct lex_token *tokens;
   };
 
-static struct lex_source *lex_source_create (struct lex_reader *);
+static struct lex_source *lex_source_create (struct lexer *,
+                                             struct lex_reader *);
 static void lex_source_destroy (struct lex_source *);
 
 /* Lexer. */
 struct lexer
   {
     struct ll_list sources;     /* Contains "struct lex_source"s. */
+    struct macro_set *macros;
   };
 
 static struct lex_source *lex_source__ (const struct lexer *);
-static struct substring lex_source_get_syntax__ (const struct lex_source *,
-                                                 int n0, int n1);
+static char *lex_source_get_syntax__ (const struct lex_source *,
+                                      int n0, int n1);
 static const struct lex_token *lex_next__ (const struct lexer *, int n);
 static void lex_source_push_endcmd__ (struct lex_source *);
 
-static void lex_source_pop__ (struct lex_source *);
-static bool lex_source_get__ (const struct lex_source *);
+static void lex_source_pop_back (struct lex_source *);
+static bool lex_source_get (const struct lex_source *);
 static void lex_source_error_valist (struct lex_source *, int n0, int n1,
                                      const char *format, va_list)
    PRINTF_FORMAT (4, 0);
@@ -150,8 +198,11 @@ lex_reader_set_file_name (struct lex_reader *reader, const char *file_name)
 struct lexer *
 lex_create (void)
 {
-  struct lexer *lexer = xzalloc (sizeof *lexer);
-  ll_init (&lexer->sources);
+  struct lexer *lexer = xmalloc (sizeof *lexer);
+  *lexer = (struct lexer) {
+    .sources = LL_INITIALIZER (lexer->sources),
+    .macros = macro_set_create (),
+  };
   return lexer;
 }
 
@@ -165,10 +216,19 @@ lex_destroy (struct lexer *lexer)
 
       ll_for_each_safe (source, next, struct lex_source, ll, &lexer->sources)
         lex_source_destroy (source);
+      macro_set_destroy (lexer->macros);
       free (lexer);
     }
 }
 
+/* Adds M to LEXER's set of macros.  M replaces any existing macro with the
+   same name.  Takes ownership of M. */
+void
+lex_define_macro (struct lexer *lexer, struct macro *m)
+{
+  macro_set_add (lexer->macros, m);
+}
+
 /* Inserts READER into LEXER so that the next token read by LEXER comes from
    READER.  Before the caller, LEXER must either be empty or at a T_ENDCMD
    token. */
@@ -176,7 +236,7 @@ void
 lex_include (struct lexer *lexer, struct lex_reader *reader)
 {
   assert (ll_is_empty (&lexer->sources) || lex_token (lexer) == T_ENDCMD);
-  ll_push_head (&lexer->sources, &lex_source_create (reader)->ll);
+  ll_push_head (&lexer->sources, &lex_source_create (lexer, reader)->ll);
 }
 
 /* Appends READER to LEXER, so that it will be read after all other current
@@ -184,34 +244,52 @@ lex_include (struct lexer *lexer, struct lex_reader *reader)
 void
 lex_append (struct lexer *lexer, struct lex_reader *reader)
 {
-  ll_push_tail (&lexer->sources, &lex_source_create (reader)->ll);
+  ll_push_tail (&lexer->sources, &lex_source_create (lexer, reader)->ll);
 }
 \f
 /* Advancing. */
 
+/* Adds a new token at the front of SRC and returns a pointer to it.  The
+   caller should initialize it.  Does not advance the middle pointer, so the
+   token isn't immediately available to the parser. */
 static struct lex_token *
 lex_push_token__ (struct lex_source *src)
 {
-  struct lex_token *token;
-
-  if (deque_is_full (&src->deque))
-    src->tokens = deque_expand (&src->deque, src->tokens, sizeof *src->tokens);
+  if (src->front - src->back >= src->capacity)
+    {
+      /* Expansion works just like a deque, so we reuse the code. */
+      struct deque deque = {
+        .capacity = src->capacity,
+        .front = src->front,
+        .back = src->back,
+      };
+      src->tokens = deque_expand (&deque, src->tokens, sizeof *src->tokens);
+      src->capacity = deque.capacity;
+      src->mask = src->capacity - 1;
+    }
 
-  token = &src->tokens[deque_push_front (&src->deque)];
+  struct lex_token *token = &src->tokens[src->front++ & src->mask];
   token->token = (struct token) { .type = T_STOP };
+  token->macro_rep = NULL;
+  token->ref_cnt = NULL;
   return token;
 }
 
+/* Removes the current token from SRC and uninitializes it. */
 static void
-lex_source_pop__ (struct lex_source *src)
+lex_source_pop_back (struct lex_source *src)
 {
-  token_uninit (&src->tokens[deque_pop_back (&src->deque)].token);
+  assert (src->middle - src->back > 0);
+  lex_token_uninit (&src->tokens[src->back++ & src->mask]);
 }
 
+/* Removes the token at the greatest lookahead from SRC and uninitializes
+   it. */
 static void
 lex_source_pop_front (struct lex_source *src)
 {
-  token_uninit (&src->tokens[deque_pop_front (&src->deque)].token);
+  assert (src->front - src->middle > 0);
+  lex_token_uninit (&src->tokens[--src->front & src->mask]);
 }
 
 /* Advances LEXER to the next token, consuming the current token. */
@@ -224,11 +302,11 @@ lex_get (struct lexer *lexer)
   if (src == NULL)
     return;
 
-  if (!deque_is_empty (&src->deque))
-    lex_source_pop__ (src);
+  if (src->middle - src->back > 0)
+    lex_source_pop_back (src);
 
-  while (deque_is_empty (&src->deque))
-    if (!lex_source_get__ (src))
+  while (src->back == src->middle)
+    if (!lex_source_get (src))
       {
         lex_source_destroy (src);
         src = lex_source__ (lexer);
@@ -857,24 +935,30 @@ lex_next__ (const struct lexer *lexer_, int n)
     }
 }
 
+/* Returns the token in SRC with the greatest lookahead. */
+static const struct lex_token *
+lex_source_middle (const struct lex_source *src)
+{
+  assert (src->middle - src->back > 0);
+  return &src->tokens[(src->middle - 1) & src->mask];
+}
+
 static const struct lex_token *
 lex_source_next__ (const struct lex_source *src, int n)
 {
-  while (deque_count (&src->deque) <= n)
+  while (src->middle - src->back <= n)
     {
-      if (!deque_is_empty (&src->deque))
+      if (src->middle - src->back > 0)
         {
-          struct lex_token *front;
-
-          front = &src->tokens[deque_front (&src->deque, 0)];
-          if (front->token.type == T_STOP || front->token.type == T_ENDCMD)
-            return front;
+          const struct lex_token *middle = lex_source_middle (src);
+          if (middle->token.type == T_STOP || middle->token.type == T_ENDCMD)
+            return middle;
         }
 
-      lex_source_get__ (src);
+      lex_source_get (src);
     }
 
-  return &src->tokens[deque_back (&src->deque, n)];
+  return &src->tokens[(src->back + n) & src->mask];
 }
 
 /* Returns the "struct token" of the token N after the current one in LEXER.
@@ -938,15 +1022,24 @@ lex_next_tokss (const struct lexer *lexer, int n)
 /* Returns the text of the syntax in tokens N0 ahead of the current one,
    through N1 ahead of the current one, inclusive.  (For example, if N0 and N1
    are both zero, this requests the syntax for the current token.)  The caller
-   must not modify or free the returned string.  The syntax is encoded in UTF-8
-   and in the original form supplied to the lexer so that, for example, it may
-   include comments, spaces, and new-lines if it spans multiple tokens. */
-struct substring
+   must eventually free the returned string (with free()).  The syntax is
+   encoded in UTF-8 and in the original form supplied to the lexer so that, for
+   example, it may include comments, spaces, and new-lines if it spans multiple
+   tokens.  Macro expansion, however, has already been performed. */
+char *
 lex_next_representation (const struct lexer *lexer, int n0, int n1)
 {
   return lex_source_get_syntax__ (lex_source__ (lexer), n0, n1);
 }
 
+/* Returns true if the token N ahead of the current one was produced by macro
+   expansion, false otherwise. */
+bool
+lex_next_is_from_macro (const struct lexer *lexer, int n)
+{
+  return lex_next__ (lexer, n)->macro_rep != NULL;
+}
+
 static bool
 lex_tokens_match (const struct token *actual, const struct token *expected)
 {
@@ -1190,7 +1283,6 @@ lex_get_encoding (const struct lexer *lexer)
   return src == NULL ? NULL : src->reader->encoding;
 }
 
-
 /* Returns the syntax mode for the syntax file from which the current drawn is
    drawn.  Returns SEG_MODE_AUTO for a T_STOP token or if the command's source
    does not have line numbers.
@@ -1238,8 +1330,10 @@ lex_interactive_reset (struct lexer *lexer)
       src->suppress_next_newline = false;
       src->segmenter = segmenter_init (segmenter_get_mode (&src->segmenter),
                                        false);
-      while (!deque_is_empty (&src->deque))
-        lex_source_pop__ (src);
+      while (src->middle - src->back > 0)
+        lex_source_pop_back (src);
+      while (src->front - src->middle > 0)
+        lex_source_pop_front (src);
       lex_source_push_endcmd__ (src);
     }
 }
@@ -1262,8 +1356,8 @@ lex_discard_noninteractive (struct lexer *lexer)
 
   if (src != NULL)
     {
-      while (!deque_is_empty (&src->deque))
-        lex_source_pop__ (src);
+      while (src->middle - src->back > 0)
+        lex_source_pop_back (src);
 
       for (; src != NULL && src->reader->error != LEX_ERROR_TERMINAL;
            src = lex_source__ (lexer))
@@ -1283,7 +1377,7 @@ lex_source_max_tail__ (const struct lex_source *src)
   /* Use the oldest token also.  (We know that src->deque cannot be empty
      because we are in the process of adding a new token, which is already
      initialized enough to use here.) */
-  token = &src->tokens[deque_back (&src->deque, 0)];
+  token = &src->tokens[src->back & src->mask];
   assert (token->token_pos >= token->line_pos);
   max_tail = MIN (max_tail, token->line_pos);
 
@@ -1350,23 +1444,86 @@ lex_source__ (const struct lexer *lexer)
           : ll_data (ll_head (&lexer->sources), struct lex_source, ll));
 }
 
-static struct substring
-lex_tokens_get_syntax__ (const struct lex_source *src,
-                         const struct lex_token *token0,
-                         const struct lex_token *token1)
+/* Returns the text of the syntax in SRC for tokens N0 ahead of the current
+   one, through N1 ahead of the current one, inclusive.  (For example, if N0
+   and N1 are both zero, this requests the syntax for the current token.)  The
+   caller must eventually free the returned string (with free()).  The syntax
+   is encoded in UTF-8 and in the original form supplied to the lexer so that,
+   for example, it may include comments, spaces, and new-lines if it spans
+   multiple tokens.  Macro expansion, however, has already been performed. */
+static char *
+lex_source_get_syntax__ (const struct lex_source *src, int n0, int n1)
 {
-  size_t start = token0->token_pos;
-  size_t end = token1->token_pos + token1->token_len;
+  struct string s = DS_EMPTY_INITIALIZER;
+  for (size_t i = n0; i <= n1; )
+    {
+      /* Find [I,J) as the longest sequence of tokens not produced by macro
+         expansion, or otherwise the longest sequence expanded from a single
+         macro call. */
+      const struct lex_token *first = lex_source_next__ (src, i);
+      size_t j;
+      for (j = i + 1; j <= n1; j++)
+        {
+          const struct lex_token *cur = lex_source_next__ (src, j);
+          if ((first->macro_rep != NULL) != (cur->macro_rep != NULL)
+              || first->macro_rep != cur->macro_rep)
+            break;
+        }
+      const struct lex_token *last = lex_source_next__ (src, j - 1);
 
-  return ss_buffer (&src->buffer[start - src->tail], end - start);
+      /* Now add the syntax for this sequence of tokens to SRC. */
+      if (!ds_is_empty (&s))
+        ds_put_byte (&s, ' ');
+      if (!first->macro_rep)
+        {
+          size_t start = first->token_pos;
+          size_t end = last->token_pos + last->token_len;
+          ds_put_substring (&s, ss_buffer (&src->buffer[start - src->tail],
+                                           end - start));
+        }
+      else
+        {
+          size_t start = first->ofs;
+          size_t end = last->ofs + last->len;
+          ds_put_substring (&s, ss_buffer (first->macro_rep + start,
+                                           end - start));
+        }
+
+      i = j;
+    }
+  return ds_steal_cstr (&s);
+}
+
+static bool
+lex_source_contains_macro_call (struct lex_source *src, int n0, int n1)
+{
+  for (size_t i = n0; i <= n1; i++)
+    if (lex_source_next__ (src, i)->macro_rep)
+      return true;
+  return false;
 }
 
+/* If tokens N0...N1 (inclusive) in SRC contains a macro call, this returns the
+   raw UTF-8 syntax for the macro call (not for the expansion) and for any
+   other tokens included in that range.  The syntax is encoded in UTF-8 and in
+   the original form supplied to the lexer so that, for example, it may include
+   comments, spaces, and new-lines if it spans multiple tokens.
+
+   Returns an empty string if the token range doesn't include a macro call.
+
+   The caller must not modify or free the returned string. */
 static struct substring
-lex_source_get_syntax__ (const struct lex_source *src, int n0, int n1)
+lex_source_get_macro_call (struct lex_source *src, int n0, int n1)
 {
-  return lex_tokens_get_syntax__ (src,
-                                  lex_source_next__ (src, n0),
-                                  lex_source_next__ (src, MAX (n0, n1)));
+  if (!lex_source_contains_macro_call (src, n0, n1))
+    return ss_empty ();
+
+  const struct lex_token *token0 = lex_source_next__ (src, n0);
+  const struct lex_token *token1 = lex_source_next__ (src, MAX (n0, n1));
+  size_t start = token0->token_pos;
+  size_t end = token1->token_pos + token1->token_len;
+
+  return ss_buffer (&src->buffer[start - src->tail], end - start);
 }
 
 static void
@@ -1383,16 +1540,35 @@ lex_source_error_valist (struct lex_source *src, int n0, int n1,
     ds_put_cstr (&s, _("Syntax error at end of command"));
   else
     {
-      struct substring syntax = lex_source_get_syntax__ (src, n0, n1);
-      if (!ss_is_empty (syntax))
+      /* Get the syntax that caused the error. */
+      char *raw_syntax = lex_source_get_syntax__ (src, n0, n1);
+      char syntax[64];
+      str_ellipsize (ss_cstr (raw_syntax), syntax, sizeof syntax);
+      free (raw_syntax);
+
+      /* Get the macro call(s) that expanded to the syntax that caused the
+         error. */
+      char call[64];
+      str_ellipsize (lex_source_get_macro_call (src, n0, n1),
+                     call, sizeof call);
+
+      if (syntax[0])
         {
-          char syntax_cstr[64];
-
-          str_ellipsize (syntax, syntax_cstr, sizeof syntax_cstr);
-          ds_put_format (&s, _("Syntax error at `%s'"), syntax_cstr);
+          if (call[0])
+            ds_put_format (&s,
+                           _("Syntax error at `%s' (in expansion of `%s')"),
+                           syntax, call);
+          else
+            ds_put_format (&s, _("Syntax error at `%s'"), syntax);
         }
       else
-        ds_put_cstr (&s, _("Syntax error"));
+        {
+          if (call[0])
+            ds_put_format (&s, _("Syntax error in syntax expanded from `%s'"),
+                           call);
+          else
+            ds_put_cstr (&s, _("Syntax error"));
+        }
     }
 
   if (format)
@@ -1434,22 +1610,26 @@ lex_source_error (struct lex_source *src, int n0, int n1,
 static void
 lex_get_error (struct lex_source *src, const char *s)
 {
-  int n = deque_count (&src->deque) - 1;
+  size_t old_middle = src->middle;
+  src->middle = src->front;
+  size_t n = src->front - src->back - 1;
   lex_source_error (src, n, n, "%s", s);
+  src->middle = old_middle;
+
   lex_source_pop_front (src);
 }
 
-/* Attempts to append an additional token into SRC's deque, reading more from
-   the underlying lex_reader if necessary.  Returns true if successful, false
-   if the deque already represents (a suffix of) the whole lex_reader's
-   contents, */
+/* Attempts to append an additional token at the front of SRC, reading more
+   from the underlying lex_reader if necessary.  Returns true if a new token
+   was added to SRC's deque, false otherwise.  The caller should retry failures
+   unless SRC's 'eof' marker was set to true indicating that there will be no
+   more tokens from this source.
+
+   Does not make the new token available for lookahead yet; the caller must
+   adjust SRC's 'middle' pointer to do so. */
 static bool
-lex_source_get__ (const struct lex_source *src_)
+lex_source_try_get__ (struct lex_source *src)
 {
-  struct lex_source *src = CONST_CAST (struct lex_source *, src_);
-  if (src->eof)
-    return false;
-
   /* State maintained while scanning tokens.  Usually we only need a single
      state, but scanner_push() can return SCAN_SAVE to indicate that the state
      needs to be saved and possibly restored later with SCAN_BACK. */
@@ -1580,12 +1760,12 @@ lex_source_get__ (const struct lex_source *src_)
   switch (token->token.type)
     {
     default:
-      break;
+      return true;
 
     case T_STOP:
       token->token.type = T_ENDCMD;
       src->eof = true;
-      break;
+      return true;
 
     case SCAN_BAD_HEX_LENGTH:
     case SCAN_BAD_HEX_DIGIT:
@@ -1598,35 +1778,202 @@ lex_source_get__ (const struct lex_source *src_)
       char *msg = scan_token_to_error (&token->token);
       lex_get_error (src, msg);
       free (msg);
-      break;
+      return false;
 
     case SCAN_SKIP:
       lex_source_pop_front (src);
-      break;
+      return false;
     }
 
+  NOT_REACHED ();
+}
+
+/* Attempts to add a new token at the front of SRC.  Returns true if
+   successful, false on failure.  On failure, the end of SRC has been reached
+   and no more tokens will be forthcoming from it.
+
+   Does not make the new token available for lookahead yet; the caller must
+   adjust SRC's 'middle' pointer to do so. */
+static bool
+lex_source_get__ (struct lex_source *src)
+{
+  while (!src->eof)
+    if (lex_source_try_get__ (src))
+      return true;
+  return false;
+}
+
+/* Attempts to obtain a new token for SRC, in particular expanding the number
+   of lookahead tokens (the tokens between 'back' and 'middle').
+
+   Returns true if successful, false on failure.  In the latter case, SRC is
+   exhausted and 'src->eof' is now true. */
+static bool
+lex_source_get (const struct lex_source *src_)
+{
+  struct lex_source *src = CONST_CAST (struct lex_source *, src_);
+
+  /* In the common case, call into the scanner and segmenter to obtain a new
+     token between 'middle' and 'front'.  In the uncommon case, there can be one
+     or a few tokens there already, leftovers from a macro expansion.
+
+     If we call into the scanner and it fails, then we've hit EOF and we're
+     done. */
+  if (src->front - src->middle == 0 && !lex_source_get__ (src))
+    return false;
+
+  /* We have at least one token available between 'middle' and 'front'.
+
+     The remaining complication is all about macro expansion.  If macro
+     expansion is disabled, we're done.  */
+  if (!settings_get_mexpand ())
+    {
+      src->middle++;
+      return true;
+    }
+
+  /* Now pass tokens one-by-one to the macro expander.
+
+     In the common case where there is no macro to expand, the loop is not
+     entered.  */
+  struct macro_call *mc;
+  int n_call = macro_call_create (
+    src->lexer->macros, &src->tokens[src->middle & src->mask].token,
+    &mc);
+  for (int middle_ofs = 1; !n_call; middle_ofs++)
+    {
+      if (src->front - src->middle <= middle_ofs && !lex_source_get__ (src))
+        {
+          /* This should not be reachable because we always get a T_ENDCMD at
+             the end of an input file (transformed from T_STOP by
+             lex_source_try_get__()) and the macro_expander should always
+             terminate expansion on T_ENDCMD. */
+          NOT_REACHED ();
+        }
+
+      const struct lex_token *t = &src->tokens[(src->middle + middle_ofs)
+                                               & src->mask];
+      size_t start = t->token_pos;
+      size_t end = t->token_pos + t->token_len;
+      const struct macro_token mt = {
+        .token = t->token,
+        .syntax = ss_buffer (&src->buffer[start - src->tail], end - start),
+      };
+
+      /* We temporarily add the tokens to the source to avoid re-entry if
+         macro_expander_add() reports an error and to give better error
+         messages. */
+      src->middle += middle_ofs + 1;
+      n_call = macro_call_add (mc, &mt);
+      src->middle -= middle_ofs + 1;
+    }
+  if (n_call < 0)
+    {
+      /* False alarm: no macro expansion after all.  Use first token as
+         lookahead.  We'll retry macro expansion from the second token next
+         time around. */
+      macro_call_destroy (mc);
+      src->middle++;
+      return true;
+    }
+
+  /* Now expand the macro.
+
+     We temporarily add the macro call's tokens to the source in case the macro
+     expansion calls msg() to report an error and error processing tries to get
+     the location of the error with, e.g. lex_get_first_line_number(), which
+     would re-enter this code.  This is a kluge; it might be cleaner to pass
+     the line number into macro_expander_get_expansion(). */
+  src->middle += n_call;
+  struct macro_tokens expansion = { .n = 0 };
+  macro_call_expand (mc, src->reader->syntax, &expansion);
+  macro_call_destroy (mc);
+  src->middle -= n_call;
+
+  /* Convert the macro expansion into syntax for possible error messages later. */
+  size_t *ofs = xnmalloc (expansion.n, sizeof *ofs);
+  size_t *len = xnmalloc (expansion.n, sizeof *len);
+  struct string s = DS_EMPTY_INITIALIZER;
+  macro_tokens_to_syntax (&expansion, &s, ofs, len);
+
+  if (settings_get_mprint ())
+    output_item_submit (text_item_create (TEXT_ITEM_LOG, ds_cstr (&s),
+                                          _("Macro Expansion")));
+
+  /* The first 'n_call' tokens starting at 'middle' will be replaced by the
+     macro expansion.  There might be more tokens after that, up to 'front'.
+
+     Figure out the boundary of the macro call in the syntax, to go into the
+     lex_tokens for the expansion so that later error messages can report what
+     macro was called. */
+  const struct lex_token *call_first = &src->tokens[src->middle & src->mask];
+  const struct lex_token *call_last
+    = &src->tokens[(src->middle + n_call - 1) & src->mask];
+  size_t call_pos = call_first->token_pos;
+  size_t call_len = (call_last->token_pos + call_last->token_len) - call_pos;
+  size_t line_pos = call_first->line_pos;
+  int first_line = call_first->first_line;
+
+  /* Destroy the tokens for the call, and save any tokens following the call so
+     we can add them back later. */
+  for (size_t i = src->middle; i != src->middle + n_call; i++)
+    lex_token_uninit (&src->tokens[i & src->mask]);
+  size_t n_save = src->front - (src->middle + n_call);
+  struct lex_token *save_tokens = xnmalloc (n_save, sizeof *save_tokens);
+  for (size_t i = 0; i < n_save; i++)
+    save_tokens[i] = src->tokens[(src->middle + n_call + i) & src->mask];
+  src->front = src->middle;
+
+  /* Append the macro expansion tokens to the lookahead. */
+  char *macro_rep = ds_steal_cstr (&s);
+  size_t *ref_cnt = xmalloc (sizeof *ref_cnt);
+  *ref_cnt = expansion.n;
+  for (size_t i = 0; i < expansion.n; i++)
+    {
+      *lex_push_token__ (src) = (struct lex_token) {
+        .token = expansion.mts[i].token,
+        .token_pos = call_pos,
+        .token_len = call_len,
+        .line_pos = line_pos,
+        .first_line = first_line,
+        .macro_rep = macro_rep,
+        .ofs = ofs[i],
+        .len = len[i],
+        .ref_cnt = ref_cnt,
+      };
+      src->middle++;
+
+      ss_dealloc (&expansion.mts[i].syntax);
+    }
+  free (expansion.mts);
+  free (ofs);
+  free (len);
+
+  /* Finally, put the saved tokens back. */
+  for (size_t i = 0; i < n_save; i++)
+    *lex_push_token__ (src) = save_tokens[i];
+  free (save_tokens);
+
   return true;
 }
 \f
 static void
 lex_source_push_endcmd__ (struct lex_source *src)
 {
-  struct lex_token *token = lex_push_token__ (src);
-  token->token.type = T_ENDCMD;
-  token->token_pos = 0;
-  token->token_len = 0;
-  token->line_pos = 0;
-  token->first_line = 0;
+  assert (src->back == src->middle && src->middle == src->front);
+  *lex_push_token__ (src) = (struct lex_token) {
+    .token = { .type = T_ENDCMD } };
+  src->middle++;
 }
 
 static struct lex_source *
-lex_source_create (struct lex_reader *reader)
+lex_source_create (struct lexer *lexer, struct lex_reader *reader)
 {
   struct lex_source *src = xmalloc (sizeof *src);
   *src = (struct lex_source) {
     .reader = reader,
     .segmenter = segmenter_init (reader->syntax, false),
-    .tokens = deque_init (&src->deque, 4, sizeof *src->tokens),
+    .lexer = lexer,
   };
 
   lex_source_push_endcmd__ (src);
@@ -1644,8 +1991,10 @@ lex_source_destroy (struct lex_source *src)
   free (file_name);
   free (encoding);
   free (src->buffer);
-  while (!deque_is_empty (&src->deque))
-    lex_source_pop__ (src);
+  while (src->middle - src->back > 0)
+    lex_source_pop_back (src);
+  while (src->front - src->middle > 0)
+    lex_source_pop_front (src);
   free (src->tokens);
   ll_remove (&src->ll);
   free (src);
index 9434fc684a520a1d9733881af66851f7938718b0..6aa900e8df70b9bbbb77da7d2c12919ff9ef15cc 100644 (file)
@@ -29,6 +29,7 @@
 #include "libpspp/prompt.h"
 
 struct lexer;
+struct macro;
 
 /* Handling of errors. */
 enum lex_error_mode
@@ -90,6 +91,9 @@ struct lex_reader *lex_reader_for_substring_nocopy (struct substring, const char
 struct lexer *lex_create (void);
 void lex_destroy (struct lexer *);
 
+/* Macros. */
+void lex_define_macro (struct lexer *, struct macro *);
+
 /* Files. */
 void lex_include (struct lexer *, struct lex_reader *);
 void lex_append (struct lexer *, struct lex_reader *);
@@ -143,8 +147,8 @@ double lex_next_tokval (const struct lexer *, int n);
 struct substring lex_next_tokss (const struct lexer *, int n);
 
 /* Token representation. */
-struct substring lex_next_representation (const struct lexer *,
-                                          int n0, int n1);
+char *lex_next_representation (const struct lexer *, int n0, int n1);
+bool lex_next_is_from_macro (const struct lexer *, int n);
 
 /* Current position. */
 int lex_get_first_line_number (const struct lexer *, int n);
diff --git a/src/language/lexer/macro.c b/src/language/lexer/macro.c
new file mode 100644 (file)
index 0000000..6b5d624
--- /dev/null
@@ -0,0 +1,2116 @@
+/* PSPP - a program for statistical analysis.
+   Copyright (C) 2021 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+#include "language/lexer/macro.h"
+
+#include <errno.h>
+#include <limits.h>
+#include <stdlib.h>
+
+#include "data/settings.h"
+#include "language/lexer/lexer.h"
+#include "language/lexer/segment.h"
+#include "language/lexer/scan.h"
+#include "libpspp/assertion.h"
+#include "libpspp/cast.h"
+#include "libpspp/i18n.h"
+#include "libpspp/message.h"
+#include "libpspp/str.h"
+#include "libpspp/string-array.h"
+#include "libpspp/stringi-map.h"
+#include "libpspp/stringi-set.h"
+
+#include "gl/c-ctype.h"
+#include "gl/ftoastr.h"
+
+#include "gettext.h"
+#define _(msgid) gettext (msgid)
+
+/* An entry in the stack of macros and macro directives being expanded.  The
+   stack is maintained as a linked list.  Entries are not dynamically allocated
+   but on the program stack. */
+struct macro_expansion_stack
+  {
+    /* Points to an outer stack entry, or NULL if this is the outermost. */
+    const struct macro_expansion_stack *next;
+
+    /* A macro name or !IF, !DO, etc. */
+    const char *name;
+
+    /* Location of the macro definition, if available. */
+    const char *file_name;
+    int first_line;
+    int last_line;
+  };
+
+/* Reports an error during macro expansion.  STACK is the stack for reporting
+   the location of the error, MT is the optional token at which the error was
+   detected, and FORMAT along with the varargs is the message to report. */
+static void PRINTF_FORMAT (3, 4)
+macro_error (const struct macro_expansion_stack *stack,
+             const struct macro_token *mt,
+             const char *format, ...)
+{
+  struct msg_stack **ms = NULL;
+  size_t allocated_ms = 0;
+  size_t n_ms = 0;
+
+  for (const struct macro_expansion_stack *p = stack; p; p = p->next)
+    {
+      if (n_ms >= allocated_ms)
+        ms = x2nrealloc (ms, &allocated_ms, sizeof *ms);
+
+      /* TRANSLATORS: These strings are used for explaining the context of an
+         error.  The "While expanding" message appears first, followed by zero
+         or more of the "inside expansion" messages.  `innermost',
+         `next_inner`, etc., are names of macros, and `foobar' is a piece of
+         PSPP syntax:
+
+         foo.sps:12: At `foobar' in the expansion of 'innermost',
+         foo.sps:23: inside the expansion of 'next_inner',
+         foo.sps:34: inside the expansion of 'next_inner2',
+         foo.sps:45: inside the expansion of 'outermost',
+         foo.sps:76: This is the actual error message. */
+      char *description;
+      if (p == stack)
+        {
+          if (mt && mt->syntax.length)
+            {
+              char syntax[64];
+              str_ellipsize (mt->syntax, syntax, sizeof syntax);
+              description = xasprintf (_("At `%s' in the expansion of `%s',"),
+                                       syntax, p->name);
+            }
+          else
+            description = xasprintf (_("In the expansion of `%s',"), p->name);
+        }
+      else
+        description = xasprintf (_("inside the expansion of `%s',"), p->name);
+
+      ms[n_ms] = xmalloc (sizeof *ms[n_ms]);
+      *ms[n_ms] = (struct msg_stack) {
+        .location = {
+          .file_name = xstrdup_if_nonnull (p->file_name),
+          .first_line = p->first_line,
+          .last_line = p->last_line,
+        },
+        .description = description,
+      };
+      n_ms++;
+    }
+
+  va_list args;
+  va_start (args, format);
+  char *s = xvasprintf (format, args);
+  va_end (args);
+
+  struct msg *m = xmalloc (sizeof *m);
+  *m = (struct msg) {
+    .category = MSG_C_SYNTAX,
+    .severity = MSG_S_ERROR,
+    .stack = ms,
+    .n_stack = n_ms,
+    .text = s,
+  };
+  msg_emit (m);
+}
+
+void
+macro_token_copy (struct macro_token *dst, const struct macro_token *src)
+{
+  token_copy (&dst->token, &src->token);
+  ss_alloc_substring (&dst->syntax, src->syntax);
+}
+
+void
+macro_token_uninit (struct macro_token *mt)
+{
+  token_uninit (&mt->token);
+  ss_dealloc (&mt->syntax);
+}
+
+void
+macro_token_to_syntax (struct macro_token *mt, struct string *s)
+{
+  ds_put_substring (s, mt->syntax);
+}
+bool
+is_macro_keyword (struct substring s)
+{
+  static struct stringi_set keywords = STRINGI_SET_INITIALIZER (keywords);
+  if (stringi_set_is_empty (&keywords))
+    {
+      static const char *kws[] = {
+        "BREAK",
+        "CHAREND",
+        "CMDEND",
+        "DEFAULT",
+        "DO",
+        "DOEND",
+        "ELSE",
+        "ENCLOSE",
+        "ENDDEFINE",
+        "IF",
+        "IFEND",
+        "IN",
+        "LET",
+        "NOEXPAND",
+        "OFFEXPAND",
+        "ONEXPAND",
+        "POSITIONAL",
+        "THEN",
+        "TOKENS",
+      };
+      for (size_t i = 0; i < sizeof kws / sizeof *kws; i++)
+        stringi_set_insert (&keywords, kws[i]);
+    }
+
+  ss_ltrim (&s, ss_cstr ("!"));
+  return stringi_set_contains_len (&keywords, s.string, s.length);
+}
+\f
+void
+macro_tokens_copy (struct macro_tokens *dst, const struct macro_tokens *src)
+{
+  *dst = (struct macro_tokens) {
+    .mts = xmalloc (src->n * sizeof *dst->mts),
+    .n = src->n,
+    .allocated = src->n,
+  };
+  for (size_t i = 0; i < src->n; i++)
+    macro_token_copy (&dst->mts[i], &src->mts[i]);
+}
+
+void
+macro_tokens_uninit (struct macro_tokens *mts)
+{
+  for (size_t i = 0; i < mts->n; i++)
+    macro_token_uninit (&mts->mts[i]);
+  free (mts->mts);
+}
+
+struct macro_token *
+macro_tokens_add_uninit (struct macro_tokens *mts)
+{
+  if (mts->n >= mts->allocated)
+    mts->mts = x2nrealloc (mts->mts, &mts->allocated, sizeof *mts->mts);
+  return &mts->mts[mts->n++];
+}
+
+void
+macro_tokens_add (struct macro_tokens *mts, const struct macro_token *mt)
+{
+  macro_token_copy (macro_tokens_add_uninit (mts), mt);
+}
+
+/* Tokenizes SRC according to MODE and appends the tokens to MTS.  Uses STACK,
+   if nonull, for error reporting. */
+static void
+macro_tokens_from_string__ (struct macro_tokens *mts, const struct substring src,
+                            enum segmenter_mode mode,
+                            const struct macro_expansion_stack *stack)
+{
+  struct state
+    {
+      struct segmenter segmenter;
+      struct substring body;
+    };
+
+  struct state state = {
+    .segmenter = segmenter_init (mode, true),
+    .body = src,
+  };
+  struct state saved = state;
+
+  while (state.body.length > 0)
+    {
+      struct macro_token mt = {
+        .token = { .type = T_STOP },
+        .syntax = { .string = state.body.string },
+      };
+      struct token *token = &mt.token;
+
+      struct scanner scanner;
+      scanner_init (&scanner, token);
+
+      for (;;)
+        {
+          enum segment_type type;
+          int seg_len = segmenter_push (&state.segmenter, state.body.string,
+                                        state.body.length, true, &type);
+          assert (seg_len >= 0);
+
+          struct substring segment = ss_head (state.body, seg_len);
+          ss_advance (&state.body, seg_len);
+
+          enum scan_result result = scanner_push (&scanner, type, segment, token);
+          if (result == SCAN_SAVE)
+            saved = state;
+          else if (result == SCAN_BACK)
+            {
+              state = saved;
+              break;
+            }
+          else if (result == SCAN_DONE)
+            break;
+        }
+
+      /* We have a token in 'token'. */
+      mt.syntax.length = state.body.string - mt.syntax.string;
+      if (is_scan_type (token->type))
+        {
+          if (token->type != SCAN_SKIP)
+            {
+              char *s = scan_token_to_error (token);
+              if (stack)
+                {
+                  mt.token.type = T_STRING;
+                  macro_error (stack, &mt, "%s", s);
+                }
+              else
+                msg (SE, "%s", s);
+              free (s);
+            }
+        }
+      else
+        macro_tokens_add (mts, &mt);
+      token_uninit (token);
+    }
+}
+
+/* Tokenizes SRC according to MODE and appends the tokens to MTS. */
+void
+macro_tokens_from_string (struct macro_tokens *mts, const struct substring src,
+                          enum segmenter_mode mode)
+{
+  macro_tokens_from_string__ (mts, src, mode, NULL);
+}
+
+void
+macro_tokens_print (const struct macro_tokens *mts, FILE *stream)
+{
+  for (size_t i = 0; i < mts->n; i++)
+    token_print (&mts->mts[i].token, stream);
+}
+
+enum token_class
+  {
+    TC_ENDCMD,                  /* No space before or after (new-line after). */
+    TC_BINOP,                   /* Space on both sides. */
+    TC_COMMA,                   /* Space afterward. */
+    TC_ID,                      /* Don't need spaces except sequentially. */
+    TC_PUNCT,                   /* Don't need spaces except sequentially. */
+  };
+
+static bool
+needs_space (enum token_class prev, enum token_class next)
+{
+  /* Don't need a space before or after the end of a command.
+     (A new-line is needed afterward as a special case.) */
+  if (prev == TC_ENDCMD || next == TC_ENDCMD)
+    return false;
+
+  /* Binary operators always have a space on both sides. */
+  if (prev == TC_BINOP || next == TC_BINOP)
+    return true;
+
+  /* A comma always has a space afterward. */
+  if (prev == TC_COMMA)
+    return true;
+
+  /* Otherwise, PREV is TC_ID or TC_PUNCT, which only need a space if there are
+     two or them in a row. */
+  return prev == next;
+}
+
+static enum token_class
+classify_token (enum token_type type)
+{
+  switch (type)
+    {
+    case T_ID:
+    case T_MACRO_ID:
+    case T_POS_NUM:
+    case T_NEG_NUM:
+    case T_STRING:
+      return TC_ID;
+
+    case T_STOP:
+      return TC_PUNCT;
+
+    case T_ENDCMD:
+      return TC_ENDCMD;
+
+    case T_LPAREN:
+    case T_RPAREN:
+    case T_LBRACK:
+    case T_RBRACK:
+      return TC_PUNCT;
+
+    case T_PLUS:
+    case T_DASH:
+    case T_ASTERISK:
+    case T_SLASH:
+    case T_EQUALS:
+    case T_AND:
+    case T_OR:
+    case T_NOT:
+    case T_EQ:
+    case T_GE:
+    case T_GT:
+    case T_LE:
+    case T_LT:
+    case T_NE:
+    case T_ALL:
+    case T_BY:
+    case T_TO:
+    case T_WITH:
+    case T_EXP:
+    case T_MACRO_PUNCT:
+      return TC_BINOP;
+
+    case T_COMMA:
+      return TC_COMMA;
+    }
+
+  NOT_REACHED ();
+}
+
+/* Appends syntax for the tokens in MTS to S.  If OFS and LEN are nonnull, sets
+   OFS[i] to the offset within S of the start of token 'i' in MTS and LEN[i] to
+   its length.  OFS[i] + LEN[i] is not necessarily OFS[i + 1] because some
+   tokens are separated by white space.  */
+void
+macro_tokens_to_syntax (struct macro_tokens *mts, struct string *s,
+                        size_t *ofs, size_t *len)
+{
+  assert ((ofs != NULL) == (len != NULL));
+
+  if (!mts->n)
+    return;
+
+  for (size_t i = 0; i < mts->n; i++)
+    {
+      if (i > 0)
+        {
+          enum token_type prev = mts->mts[i - 1].token.type;
+          enum token_type next = mts->mts[i].token.type;
+
+          if (prev == T_ENDCMD)
+            ds_put_byte (s, '\n');
+          else
+            {
+              enum token_class pc = classify_token (prev);
+              enum token_class nc = classify_token (next);
+              if (needs_space (pc, nc))
+                ds_put_byte (s, ' ');
+            }
+        }
+
+      if (ofs)
+        ofs[i] = s->ss.length;
+      macro_token_to_syntax (&mts->mts[i], s);
+      if (len)
+        len[i] = s->ss.length - ofs[i];
+    }
+}
+
+void
+macro_destroy (struct macro *m)
+{
+  if (!m)
+    return;
+
+  free (m->name);
+  free (m->file_name);
+  for (size_t i = 0; i < m->n_params; i++)
+    {
+      struct macro_param *p = &m->params[i];
+      free (p->name);
+
+      macro_tokens_uninit (&p->def);
+
+      switch (p->arg_type)
+        {
+        case ARG_N_TOKENS:
+          break;
+
+        case ARG_CHAREND:
+          token_uninit (&p->charend);
+          break;
+
+        case ARG_ENCLOSE:
+          token_uninit (&p->enclose[0]);
+          token_uninit (&p->enclose[1]);
+          break;
+
+        case ARG_CMDEND:
+          break;
+        }
+    }
+  free (m->params);
+  macro_tokens_uninit (&m->body);
+  free (m);
+}
+\f
+struct macro_set *
+macro_set_create (void)
+{
+  struct macro_set *set = xmalloc (sizeof *set);
+  *set = (struct macro_set) {
+    .macros = HMAP_INITIALIZER (set->macros),
+  };
+  return set;
+}
+
+void
+macro_set_destroy (struct macro_set *set)
+{
+  if (!set)
+    return;
+
+  struct macro *macro, *next;
+  HMAP_FOR_EACH_SAFE (macro, next, struct macro, hmap_node, &set->macros)
+    {
+      hmap_delete (&set->macros, &macro->hmap_node);
+      macro_destroy (macro);
+    }
+  hmap_destroy (&set->macros);
+  free (set);
+}
+
+static unsigned int
+hash_macro_name (const char *name)
+{
+  return utf8_hash_case_string (name, 0);
+}
+
+static struct macro *
+macro_set_find__ (struct macro_set *set, const char *name)
+{
+  if (macro_set_is_empty (set))
+    return NULL;
+
+  struct macro *macro;
+  HMAP_FOR_EACH_WITH_HASH (macro, struct macro, hmap_node,
+                           hash_macro_name (name), &set->macros)
+    if (!utf8_strcasecmp (macro->name, name))
+      return macro;
+
+  return NULL;
+}
+
+const struct macro *
+macro_set_find (const struct macro_set *set, const char *name)
+{
+  return macro_set_find__ (CONST_CAST (struct macro_set *, set), name);
+}
+
+/* Adds M to SET.  M replaces any existing macro with the same name.  Takes
+   ownership of M. */
+void
+macro_set_add (struct macro_set *set, struct macro *m)
+{
+  struct macro *victim = macro_set_find__ (set, m->name);
+  if (victim)
+    {
+      hmap_delete (&set->macros, &victim->hmap_node);
+      macro_destroy (victim);
+    }
+
+  hmap_insert (&set->macros, &m->hmap_node, hash_macro_name (m->name));
+}
+\f
+/* Macro call parsing.. */
+
+enum mc_state
+  {
+    /* Error state. */
+    MC_ERROR,
+
+    /* Accumulating tokens in mc->params toward the end of any type of
+       argument. */
+    MC_ARG,
+
+    /* Expecting the opening delimiter of an ARG_ENCLOSE argument. */
+    MC_ENCLOSE,
+
+    /* Expecting a keyword for a keyword argument. */
+    MC_KEYWORD,
+
+    /* Expecting an equal sign for a keyword argument. */
+    MC_EQUALS,
+
+    /* Macro fully parsed and ready for expansion. */
+    MC_FINISHED,
+  };
+
+/* Parsing macro calls.  This is a FSM driven by macro_call_create() and
+   macro_call_add() to identify the macro being called and obtain its
+   arguments.  'state' identifies the FSM state. */
+struct macro_call
+  {
+    const struct macro_set *macros;
+    const struct macro *macro;
+    struct macro_tokens **args;
+
+    enum mc_state state;
+    size_t n_tokens;
+    const struct macro_param *param; /* Parameter currently being parsed. */
+  };
+
+/* Completes macro expansion by initializing arguments that weren't supplied to
+   their defaults. */
+static int
+mc_finished (struct macro_call *mc)
+{
+  mc->state = MC_FINISHED;
+  for (size_t i = 0; i < mc->macro->n_params; i++)
+    if (!mc->args[i])
+      mc->args[i] = &mc->macro->params[i].def;
+  return mc->n_tokens;
+}
+
+static int
+mc_next_arg (struct macro_call *mc)
+{
+  if (!mc->param)
+    {
+      assert (!mc->macro->n_params);
+      return mc_finished (mc);
+    }
+  else if (mc->param->positional)
+    {
+      mc->param++;
+      if (mc->param >= &mc->macro->params[mc->macro->n_params])
+        return mc_finished (mc);
+      else
+        {
+          mc->state = (!mc->param->positional ? MC_KEYWORD
+                       : mc->param->arg_type == ARG_ENCLOSE ? MC_ENCLOSE
+                       : MC_ARG);
+          return 0;
+        }
+    }
+  else
+    {
+      for (size_t i = 0; i < mc->macro->n_params; i++)
+        if (!mc->args[i])
+          {
+            mc->state = MC_KEYWORD;
+            return 0;
+          }
+      return mc_finished (mc);
+    }
+}
+
+static int
+mc_error (struct macro_call *mc)
+{
+  mc->state = MC_ERROR;
+  return -1;
+}
+
+static int
+mc_add_arg (struct macro_call *mc, const struct macro_token *mt)
+{
+  const struct macro_param *p = mc->param;
+
+  const struct token *token = &mt->token;
+  if ((token->type == T_ENDCMD || token->type == T_STOP)
+      && p->arg_type != ARG_CMDEND)
+    {
+      msg (SE, _("Unexpected end of command reading argument %s "
+                 "to macro %s."), mc->param->name, mc->macro->name);
+
+      return mc_error (mc);
+    }
+
+  mc->n_tokens++;
+
+  struct macro_tokens **argp = &mc->args[p - mc->macro->params];
+  if (!*argp)
+    *argp = xzalloc (sizeof **argp);
+  struct macro_tokens *arg = *argp;
+  if (p->arg_type == ARG_N_TOKENS)
+    {
+      macro_tokens_add (arg, mt);
+      if (arg->n >= p->n_tokens)
+        return mc_next_arg (mc);
+      return 0;
+    }
+  else if (p->arg_type == ARG_CMDEND)
+    {
+      if (token->type == T_ENDCMD || token->type == T_STOP)
+        return mc_next_arg (mc);
+      macro_tokens_add (arg, mt);
+      return 0;
+    }
+  else
+    {
+      const struct token *end
+        = p->arg_type == ARG_CHAREND ? &p->charend : &p->enclose[1];
+      if (token_equal (token, end))
+        return mc_next_arg (mc);
+      macro_tokens_add (arg, mt);
+      return 0;
+    }
+}
+
+static int
+mc_expected (struct macro_call *mc, const struct macro_token *actual,
+             const struct token *expected)
+{
+  const struct substring actual_s = (actual->syntax.length ? actual->syntax
+                                     : ss_cstr (_("<end of input>")));
+  char *expected_s = token_to_string (expected);
+  msg (SE, _("Found `%.*s' while expecting `%s' reading argument %s "
+             "to macro %s."),
+       (int) actual_s.length, actual_s.string, expected_s,
+       mc->param->name, mc->macro->name);
+  free (expected_s);
+
+  return mc_error (mc);
+}
+
+static int
+mc_enclose (struct macro_call *mc, const struct macro_token *mt)
+{
+  const struct token *token = &mt->token;
+  mc->n_tokens++;
+
+  if (token_equal (&mc->param->enclose[0], token))
+    {
+      mc->state = MC_ARG;
+      return 0;
+    }
+
+  return mc_expected (mc, mt, &mc->param->enclose[0]);
+}
+
+static const struct macro_param *
+macro_find_parameter_by_name (const struct macro *m, struct substring name)
+{
+  if (!m)
+    return NULL;
+
+  ss_ltrim (&name, ss_cstr ("!"));
+
+  for (size_t i = 0; i < m->n_params; i++)
+    {
+      const struct macro_param *p = &m->params[i];
+      struct substring p_name = ss_cstr (p->name + 1);
+      if (!utf8_strncasecmp (p_name.string, p_name.length,
+                             name.string, name.length))
+        return p;
+    }
+  return NULL;
+}
+
+static int
+mc_keyword (struct macro_call *mc, const struct macro_token *mt)
+{
+  const struct token *token = &mt->token;
+  if (token->type != T_ID)
+    return mc_finished (mc);
+
+  const struct macro_param *p = macro_find_parameter_by_name (mc->macro,
+                                                              token->string);
+  if (p)
+    {
+      size_t arg_index = p - mc->macro->params;
+      mc->param = p;
+      if (mc->args[arg_index])
+        {
+          msg (SE,
+               _("Argument %s multiply specified in call to macro %s."),
+               p->name, mc->macro->name);
+          return mc_error (mc);
+        }
+
+      mc->n_tokens++;
+      mc->state = MC_EQUALS;
+      return 0;
+    }
+
+  return mc_finished (mc);
+}
+
+static int
+mc_equals (struct macro_call *mc, const struct macro_token *mt)
+{
+  const struct token *token = &mt->token;
+  mc->n_tokens++;
+
+  if (token->type == T_EQUALS)
+    {
+      mc->state = MC_ARG;
+      return 0;
+    }
+
+  return mc_expected (mc, mt, &(struct token) { .type = T_EQUALS });
+}
+
+/* If TOKEN is the first token of a call to a macro in MACROS, create a new
+   macro expander, initializes *MCP to it.  Returns 0 if more tokens are needed
+   and should be added via macro_call_add() or 1 if the caller should next call
+   macro_call_get_expansion().
+
+   If TOKEN is not the first token of a macro call, returns -1 and sets *MCP to
+   NULL. */
+int
+macro_call_create (const struct macro_set *macros,
+                   const struct token *token,
+                   struct macro_call **mcp)
+{
+  const struct macro *macro = (token->type == T_ID || token->type == T_MACRO_ID
+                               ? macro_set_find (macros, token->string.string)
+                               : NULL);
+  if (!macro)
+    {
+      *mcp = NULL;
+      return -1;
+    }
+
+  struct macro_call *mc = xmalloc (sizeof *mc);
+  *mc = (struct macro_call) {
+    .macros = macros,
+    .macro = macro,
+    .n_tokens = 1,
+    .state = (!macro->n_params ? MC_FINISHED
+              : !macro->params[0].positional ? MC_KEYWORD
+              : macro->params[0].arg_type == ARG_ENCLOSE ? MC_ENCLOSE
+              : MC_ARG),
+    .args = macro->n_params ? xcalloc (macro->n_params, sizeof *mc->args) : NULL,
+    .param = macro->params,
+  };
+  *mcp = mc;
+
+  return mc->state == MC_FINISHED ? 1 : 0;
+}
+
+void
+macro_call_destroy (struct macro_call *mc)
+{
+  if (!mc)
+    return;
+
+  for (size_t i = 0; i < mc->macro->n_params; i++)
+    {
+      struct macro_tokens *a = mc->args[i];
+      if (a && a != &mc->macro->params[i].def)
+        {
+          macro_tokens_uninit (a);
+          free (a);
+        }
+    }
+  free (mc->args);
+  free (mc);
+}
+
+/* Adds TOKEN to the collection of tokens in MC that potentially need to be
+   macro expanded.
+
+   Returns -1 if the tokens added do not actually invoke a macro.  The caller
+   should consume the first token without expanding it.  (Later tokens might
+   invoke a macro so it's best to feed the second token into a new expander.)
+
+   Returns 0 if the macro expander needs more tokens, for macro arguments or to
+   decide whether this is actually a macro invocation.  The caller should call
+   macro_call_add() again with the next token.
+
+   Returns a positive number to indicate that the returned number of tokens
+   invoke a macro.  The number returned might be less than the number of tokens
+   added because it can take a few tokens of lookahead to determine whether the
+   macro invocation is finished.  The caller should call
+   macro_call_get_expansion() to obtain the expansion. */
+int
+macro_call_add (struct macro_call *mc, const struct macro_token *mt)
+{
+  switch (mc->state)
+    {
+    case MC_ERROR:
+      return -1;
+
+    case MC_ARG:
+      return mc_add_arg (mc, mt);
+
+    case MC_ENCLOSE:
+      return mc_enclose (mc, mt);
+
+    case MC_KEYWORD:
+      return mc_keyword (mc, mt);
+
+    case MC_EQUALS:
+      return mc_equals (mc, mt);
+
+    default:
+      NOT_REACHED ();
+    }
+}
+\f
+/* Macro expansion. */
+
+struct macro_expander
+  {
+    /* Always available. */
+    const struct macro_set *macros;     /* Macros to expand recursively. */
+    enum segmenter_mode segmenter_mode; /* Mode for tokenization. */
+    int nesting_countdown;              /* Remaining nesting levels. */
+    const struct macro_expansion_stack *stack; /* Stack for error reporting. */
+    bool *expand;                       /* May macro calls be expanded? */
+    struct stringi_map *vars;           /* Variables from !DO and !LET. */
+
+    /* Only nonnull if inside a !DO loop. */
+    bool *break_;                       /* Set to true to break out of loop. */
+
+    /* Only nonnull if expanding a macro (and not, say, a macro argument). */
+    const struct macro *macro;
+    struct macro_tokens **args;
+  };
+
+static void
+macro_expand (const struct macro_token *mts, size_t n_mts,
+              const struct macro_expander *, struct macro_tokens *);
+
+static size_t
+expand_macro_function (const struct macro_expander *me,
+                       const struct macro_token *input, size_t n_input,
+                       struct string *output);
+
+/* Returns true if the N tokens within MTS start with !*, false otherwise. */
+static bool
+is_bang_star (const struct macro_token *mts, size_t n)
+{
+  return (n > 1
+          && mts[0].token.type == T_MACRO_ID
+          && ss_equals (mts[0].token.string, ss_cstr ("!"))
+          && mts[1].token.type == T_ASTERISK);
+}
+
+/* Parses one function argument from the N_INPUT tokens in INPUT
+   Each argument to a macro function is one of:
+
+       - A quoted string or other single literal token.
+
+       - An argument to the macro being expanded, e.g. !1 or a named argument.
+
+       - !*.
+
+       - A function invocation.
+
+   Each function invocation yields a character sequence to be turned into a
+   sequence of tokens.  The case where that character sequence is a single
+   quoted string is an important special case.
+*/
+static size_t
+parse_function_arg (const struct macro_expander *me,
+                    const struct macro_token *input, size_t n_input,
+                    struct string *farg)
+{
+  assert (n_input > 0);
+
+  const struct token *token = &input[0].token;
+  if (token->type == T_MACRO_ID && me->macro)
+    {
+      const struct macro_param *param = macro_find_parameter_by_name (
+        me->macro, token->string);
+      if (param)
+        {
+          size_t param_idx = param - me->macro->params;
+          macro_tokens_to_syntax (me->args[param_idx], farg, NULL, NULL);
+          return 1;
+        }
+
+      if (is_bang_star (input, n_input))
+        {
+          for (size_t i = 0; i < me->macro->n_params; i++)
+            {
+              if (!me->macro->params[i].positional)
+                break;
+              if (i)
+                ds_put_byte (farg, ' ');
+              macro_tokens_to_syntax (me->args[i], farg, NULL, NULL);
+            }
+          return 2;
+        }
+
+      const char *var = stringi_map_find__ (me->vars,
+                                            token->string.string,
+                                            token->string.length);
+      if (var)
+        {
+          ds_put_cstr (farg, var);
+          return 1;
+        }
+
+      size_t n_function = expand_macro_function (me, input, n_input, farg);
+      if (n_function)
+        return n_function;
+    }
+
+  ds_put_substring (farg, input[0].syntax);
+  return 1;
+}
+
+static size_t
+parse_function_args (const struct macro_expander *me,
+                     const struct macro_token *mts, size_t n,
+                     const char *function,
+                     struct string_array *args)
+{
+  if (n < 2 || mts[1].token.type != T_LPAREN)
+    {
+      macro_error (me->stack, n > 1 ? &mts[1] : NULL,
+                   _("`(' expected following %s."), function);
+      return 0;
+    }
+
+  for (size_t i = 2; i < n; )
+    {
+      if (mts[i].token.type == T_RPAREN)
+        return i + 1;
+
+      struct string s = DS_EMPTY_INITIALIZER;
+      i += parse_function_arg (me, mts + i, n - i, &s);
+      string_array_append_nocopy (args, ds_steal_cstr (&s));
+
+      if (i >= n)
+        break;
+      else if (mts[i].token.type == T_COMMA)
+        i++;
+      else if (mts[i].token.type != T_RPAREN)
+        {
+          macro_error (me->stack, &mts[i],
+                       _("`,' or `)' expected in call to macro function %s."),
+                       function);
+          return 0;
+        }
+    }
+
+  macro_error (me->stack, NULL, _("Missing `)' in call to macro function %s."),
+               function);
+  return 0;
+}
+
+static bool
+unquote_string (const char *s, enum segmenter_mode segmenter_mode,
+                struct string *content)
+{
+  struct string_lexer slex;
+  string_lexer_init (&slex, s, strlen (s), segmenter_mode, true);
+
+  struct token token1;
+  if (!string_lexer_next (&slex, &token1))
+    return false;
+
+  if (token1.type != T_STRING)
+    {
+      token_uninit (&token1);
+      return false;
+    }
+
+  struct token token2;
+  if (string_lexer_next (&slex, &token2))
+    {
+      token_uninit (&token1);
+      token_uninit (&token2);
+      return false;
+    }
+
+  ds_put_substring (content, token1.string);
+  token_uninit (&token1);
+  return true;
+}
+
+static const char *
+unquote_string_in_place (const char *s, enum segmenter_mode segmenter_mode,
+                         struct string *tmp)
+{
+  ds_init_empty (tmp);
+  return unquote_string (s, segmenter_mode, tmp) ? ds_cstr (tmp) : s;
+}
+
+static bool
+parse_integer (const char *s, int *np)
+{
+  errno = 0;
+
+  char *tail;
+  long int n = strtol (s, &tail, 10);
+  *np = n < INT_MIN ? INT_MIN : n > INT_MAX ? INT_MAX : n;
+  tail += strspn (tail, CC_SPACES);
+  return *tail == '\0' && errno != ERANGE && n == *np;
+}
+
+static size_t
+expand_macro_function (const struct macro_expander *me,
+                       const struct macro_token *input, size_t n_input,
+                       struct string *output)
+{
+  if (!n_input || input[0].token.type != T_MACRO_ID)
+    return 0;
+
+  struct macro_function
+    {
+      const char *name;
+      int min_args;
+      int max_args;
+    };
+  enum macro_function_id
+    {
+      MF_BLANKS,
+      MF_CONCAT,
+      MF_EVAL,
+      MF_HEAD,
+      MF_INDEX,
+      MF_LENGTH,
+      MF_NULL,
+      MF_QUOTE,
+      MF_SUBSTR,
+      MF_TAIL,
+      MF_UNQUOTE,
+      MF_UPCASE,
+    };
+  static const struct macro_function mfs[] = {
+    [MF_BLANKS]  = { "!BLANKS",  1, 1 },
+    [MF_CONCAT]  = { "!CONCAT",  1, INT_MAX },
+    [MF_EVAL]    = { "!EVAL",    1, 1 },
+    [MF_HEAD]    = { "!HEAD",    1, 1 },
+    [MF_INDEX]   = { "!INDEX",   2, 2 },
+    [MF_LENGTH]  = { "!LENGTH",  1, 1 },
+    [MF_NULL]    = { "!NULL",    0, 0 },
+    [MF_QUOTE]   = { "!QUOTE",   1, 1 },
+    [MF_SUBSTR]  = { "!SUBSTR",  2, 3 },
+    [MF_TAIL]    = { "!TAIL",    1, 1 },
+    [MF_UNQUOTE] = { "!UNQUOTE", 1, 1 },
+    [MF_UPCASE]  = { "!UPCASE",  1, 1 },
+  };
+
+  /* Is this a macro function? */
+  const struct macro_function *mf;
+  for (mf = mfs; ; mf++)
+    {
+      if (mf >= mfs + sizeof mfs / sizeof *mfs)
+        {
+          /* Not a macro function. */
+          return 0;
+        }
+
+      if (lex_id_match_n (ss_cstr (mf->name), input[0].token.string, 4))
+        break;
+    }
+
+  enum macro_function_id id = mf - mfs;
+  if (id == MF_NULL)
+    return 1;
+
+  struct string_array args = STRING_ARRAY_INITIALIZER;
+  size_t n_consumed = parse_function_args (me, input, n_input, mf->name, &args);
+  if (!n_consumed)
+    return 0;
+
+  if (args.n < mf->min_args || args.n > mf->max_args)
+    {
+      if (mf->min_args == 1 && mf->max_args == 1)
+        macro_error (me->stack, NULL,
+                     _("Macro function %s takes one argument (not %zu)."),
+                     mf->name, args.n);
+      else if (mf->min_args == 2 && mf->max_args == 2)
+        macro_error (me->stack, NULL,
+                     _("Macro function %s takes two arguments (not %zu)."),
+                     mf->name, args.n);
+      else if (mf->min_args == 2 && mf->max_args == 3)
+        macro_error (me->stack, NULL,
+                     _("Macro function %s takes two or three arguments "
+                       "(not %zu)."),
+                     mf->name, args.n);
+      else if (mf->min_args == 1 && mf->max_args == INT_MAX)
+        macro_error (me->stack, NULL,
+                     _("Macro function %s needs at least one argument."),
+                     mf->name);
+      else
+        NOT_REACHED ();
+      return 0;
+    }
+
+  switch (id)
+    {
+    case MF_LENGTH:
+      ds_put_format (output, "%zu", strlen (args.strings[0]));
+      break;
+
+    case MF_BLANKS:
+      {
+        int n;
+        if (!parse_integer (args.strings[0], &n))
+          {
+            macro_error (me->stack, NULL,
+                         _("Argument to !BLANKS must be non-negative integer "
+                           "(not \"%s\")."), args.strings[0]);
+            string_array_destroy (&args);
+            return 0;
+          }
+
+        ds_put_byte_multiple (output, ' ', n);
+      }
+      break;
+
+    case MF_CONCAT:
+      for (size_t i = 0; i < args.n; i++)
+        if (!unquote_string (args.strings[i], me->segmenter_mode, output))
+          ds_put_cstr (output, args.strings[i]);
+      break;
+
+    case MF_HEAD:
+      {
+        struct string tmp;
+        const char *s = unquote_string_in_place (args.strings[0],
+                                                 me->segmenter_mode, &tmp);
+
+        struct macro_tokens mts = { .n = 0 };
+        macro_tokens_from_string__ (&mts, ss_cstr (s), me->segmenter_mode,
+                                    me->stack);
+        if (mts.n > 0)
+          ds_put_substring (output, mts.mts[0].syntax);
+        macro_tokens_uninit (&mts);
+        ds_destroy (&tmp);
+      }
+      break;
+
+    case MF_INDEX:
+      {
+        const char *haystack = args.strings[0];
+        const char *needle = strstr (haystack, args.strings[1]);
+        ds_put_format (output, "%zu", needle ? needle - haystack + 1 : 0);
+      }
+      break;
+
+    case MF_QUOTE:
+      if (unquote_string (args.strings[0], me->segmenter_mode, NULL))
+        ds_put_cstr (output, args.strings[0]);
+      else
+        {
+          ds_extend (output, strlen (args.strings[0]) + 2);
+          ds_put_byte (output, '\'');
+          for (const char *p = args.strings[0]; *p; p++)
+            {
+              if (*p == '\'')
+                ds_put_byte (output, '\'');
+              ds_put_byte (output, *p);
+            }
+          ds_put_byte (output, '\'');
+        }
+      break;
+
+    case MF_SUBSTR:
+      {
+        int start;
+        if (!parse_integer (args.strings[1], &start) || start < 1)
+          {
+            macro_error (me->stack, NULL,
+                         _("Second argument of !SUBSTR must be "
+                           "positive integer (not \"%s\")."),
+                         args.strings[1]);
+            string_array_destroy (&args);
+            return 0;
+          }
+
+        int count = INT_MAX;
+        if (args.n > 2 && (!parse_integer (args.strings[2], &count) || count < 0))
+          {
+            macro_error (me->stack, NULL,
+                         _("Third argument of !SUBSTR must be "
+                           "non-negative integer (not \"%s\")."),
+                         args.strings[2]);
+            string_array_destroy (&args);
+            return 0;
+          }
+
+        struct substring s = ss_cstr (args.strings[0]);
+        ds_put_substring (output, ss_substr (s, start - 1, count));
+      }
+      break;
+
+    case MF_TAIL:
+      {
+        struct string tmp;
+        const char *s = unquote_string_in_place (args.strings[0],
+                                                 me->segmenter_mode, &tmp);
+
+        struct macro_tokens mts = { .n = 0 };
+        macro_tokens_from_string__ (&mts, ss_cstr (s), me->segmenter_mode,
+                                    me->stack);
+        if (mts.n > 1)
+          {
+            struct macro_tokens tail = { .mts = mts.mts + 1, .n = mts.n - 1 };
+            macro_tokens_to_syntax (&tail, output, NULL, NULL);
+          }
+        macro_tokens_uninit (&mts);
+        ds_destroy (&tmp);
+      }
+      break;
+
+    case MF_UNQUOTE:
+      if (!unquote_string (args.strings[0], me->segmenter_mode, output))
+        ds_put_cstr (output, args.strings[0]);
+      break;
+
+    case MF_UPCASE:
+      {
+        struct string tmp;
+        const char *s = unquote_string_in_place (args.strings[0],
+                                                 me->segmenter_mode, &tmp);
+        char *upper = utf8_to_upper (s);
+        ds_put_cstr (output, upper);
+        free (upper);
+        ds_destroy (&tmp);
+      }
+      break;
+
+    case MF_EVAL:
+      {
+        struct macro_tokens mts = { .n = 0 };
+        macro_tokens_from_string__ (&mts, ss_cstr (args.strings[0]),
+                                    me->segmenter_mode, me->stack);
+        struct macro_tokens exp = { .n = 0 };
+        struct macro_expansion_stack stack = {
+          .name = "!EVAL",
+          .next = me->stack
+        };
+        struct macro_expander subme = *me;
+        subme.break_ = NULL;
+        subme.stack = &stack;
+
+        macro_expand (mts.mts, mts.n, &subme, &exp);
+        macro_tokens_to_syntax (&exp, output, NULL, NULL);
+        macro_tokens_uninit (&exp);
+        macro_tokens_uninit (&mts);
+      }
+      break;
+
+    default:
+      NOT_REACHED ();
+    }
+
+  string_array_destroy (&args);
+  return n_consumed;
+}
+
+static char *macro_evaluate_or (const struct macro_expander *me,
+                                const struct macro_token **tokens,
+                                const struct macro_token *end);
+
+static char *
+macro_evaluate_literal (const struct macro_expander *me,
+                        const struct macro_token **tokens,
+                        const struct macro_token *end)
+{
+  const struct macro_token *p = *tokens;
+  if (p >= end)
+    return NULL;
+  if (p->token.type == T_LPAREN)
+    {
+      p++;
+      char *value = macro_evaluate_or (me, &p, end);
+      if (!value)
+        return NULL;
+      if (p >= end || p->token.type != T_RPAREN)
+        {
+          free (value);
+          macro_error (me->stack, p < end ? p : NULL,
+                       _("Expecting ')' in macro expression."));
+          return NULL;
+        }
+      p++;
+      *tokens = p;
+      return value;
+    }
+  else if (p->token.type == T_RPAREN)
+    {
+      macro_error (me->stack, p, _("Expecting literal or function invocation "
+                                   "in macro expression."));
+      return NULL;
+    }
+
+  struct string function_output = DS_EMPTY_INITIALIZER;
+  size_t function_consumed = parse_function_arg (me, p, end - p,
+                                                 &function_output);
+  struct string unquoted = DS_EMPTY_INITIALIZER;
+  if (unquote_string (ds_cstr (&function_output), me->segmenter_mode,
+                      &unquoted))
+    {
+      ds_swap (&function_output, &unquoted);
+      ds_destroy (&unquoted);
+    }
+  *tokens = p + function_consumed;
+  return ds_steal_cstr (&function_output);
+}
+
+/* Returns true if MT is valid as a macro operator.  Only operators written as
+   symbols (e.g. <>) are usable in macro expressions, not operator written as
+   letters (e.g. EQ). */
+static bool
+is_macro_operator (const struct macro_token *mt)
+{
+  return mt->syntax.length > 0 && !c_isalpha (mt->syntax.string[0]);
+}
+
+static enum token_type
+parse_relational_op (const struct macro_token *mt)
+{
+  switch (mt->token.type)
+    {
+    case T_EQUALS:
+      return T_EQ;
+
+    case T_NE:
+    case T_LT:
+    case T_GT:
+    case T_LE:
+    case T_GE:
+      return is_macro_operator (mt) ? mt->token.type : T_STOP;
+
+    case T_MACRO_ID:
+      return (ss_equals_case (mt->token.string, ss_cstr ("!EQ")) ? T_EQ
+              : ss_equals_case (mt->token.string, ss_cstr ("!NE")) ? T_NE
+              : ss_equals_case (mt->token.string, ss_cstr ("!LT")) ? T_LT
+              : ss_equals_case (mt->token.string, ss_cstr ("!GT")) ? T_GT
+              : ss_equals_case (mt->token.string, ss_cstr ("!LE")) ? T_LE
+              : ss_equals_case (mt->token.string, ss_cstr ("!GE")) ? T_GE
+              : T_STOP);
+
+    default:
+      return T_STOP;
+    }
+}
+
+static char *
+macro_evaluate_relational (const struct macro_expander *me,
+                           const struct macro_token **tokens,
+                           const struct macro_token *end)
+{
+  const struct macro_token *p = *tokens;
+  char *lhs = macro_evaluate_literal (me, &p, end);
+  if (!lhs)
+    return NULL;
+
+  enum token_type op = p >= end ? T_STOP : parse_relational_op (p);
+  if (op == T_STOP)
+    {
+      *tokens = p;
+      return lhs;
+    }
+  p++;
+
+  char *rhs = macro_evaluate_literal (me, &p, end);
+  if (!rhs)
+    {
+      free (lhs);
+      return NULL;
+    }
+
+  struct string lhs_tmp, rhs_tmp;
+  int cmp = strcmp (unquote_string_in_place (lhs, me->segmenter_mode,
+                                             &lhs_tmp),
+                    unquote_string_in_place (rhs, me->segmenter_mode,
+                                             &rhs_tmp));
+  ds_destroy (&lhs_tmp);
+  ds_destroy (&rhs_tmp);
+
+  free (lhs);
+  free (rhs);
+
+  bool b = (op == T_EQUALS || op == T_EQ ? !cmp
+            : op == T_NE ? cmp
+            : op == T_LT ? cmp < 0
+            : op == T_GT ? cmp > 0
+            : op == T_LE ? cmp <= 0
+            : /* T_GE */ cmp >= 0);
+
+  *tokens = p;
+  return xstrdup (b ? "1" : "0");
+}
+
+static char *
+macro_evaluate_not (const struct macro_expander *me,
+                    const struct macro_token **tokens,
+                    const struct macro_token *end)
+{
+  const struct macro_token *p = *tokens;
+
+  unsigned int negations = 0;
+  while (p < end
+         && (ss_equals_case (p->syntax, ss_cstr ("!NOT"))
+             || ss_equals (p->syntax, ss_cstr ("~"))))
+    {
+      p++;
+      negations++;
+    }
+
+  char *operand = macro_evaluate_relational (me, &p, end);
+  if (!operand || !negations)
+    {
+      *tokens = p;
+      return operand;
+    }
+
+  bool b = strcmp (operand, "0") ^ (negations & 1);
+  free (operand);
+  *tokens = p;
+  return xstrdup (b ? "1" : "0");
+}
+
+static char *
+macro_evaluate_and (const struct macro_expander *me,
+                    const struct macro_token **tokens,
+                    const struct macro_token *end)
+{
+  const struct macro_token *p = *tokens;
+  char *lhs = macro_evaluate_not (me, &p, end);
+  if (!lhs)
+    return NULL;
+
+  while (p < end
+         && (ss_equals_case (p->syntax, ss_cstr ("!AND"))
+             || ss_equals (p->syntax, ss_cstr ("&"))))
+    {
+      p++;
+      char *rhs = macro_evaluate_not (me, &p, end);
+      if (!rhs)
+        {
+          free (lhs);
+          return NULL;
+        }
+
+      bool b = strcmp (lhs, "0") && strcmp (rhs, "0");
+      free (lhs);
+      free (rhs);
+      lhs = xstrdup (b ? "1" : "0");
+    }
+  *tokens = p;
+  return lhs;
+}
+
+static char *
+macro_evaluate_or (const struct macro_expander *me,
+                   const struct macro_token **tokens,
+                   const struct macro_token *end)
+{
+  const struct macro_token *p = *tokens;
+  char *lhs = macro_evaluate_and (me, &p, end);
+  if (!lhs)
+    return NULL;
+
+  while (p < end
+         && (ss_equals_case (p->syntax, ss_cstr ("!OR"))
+             || ss_equals (p->syntax, ss_cstr ("|"))))
+    {
+      p++;
+      char *rhs = macro_evaluate_and (me, &p, end);
+      if (!rhs)
+        {
+          free (lhs);
+          return NULL;
+        }
+
+      bool b = strcmp (lhs, "0") || strcmp (rhs, "0");
+      free (lhs);
+      free (rhs);
+      lhs = xstrdup (b ? "1" : "0");
+    }
+  *tokens = p;
+  return lhs;
+}
+
+static char *
+macro_evaluate_expression (const struct macro_token **tokens, size_t n_tokens,
+                           const struct macro_expander *me)
+{
+  return macro_evaluate_or (me, tokens, *tokens + n_tokens);
+}
+
+static bool
+macro_evaluate_number (const struct macro_token **tokens, size_t n_tokens,
+                       const struct macro_expander *me,
+                       double *number)
+{
+  char *s = macro_evaluate_expression (tokens, n_tokens, me);
+  if (!s)
+    return false;
+
+  struct macro_tokens mts = { .n = 0 };
+  macro_tokens_from_string__ (&mts, ss_cstr (s), me->segmenter_mode, me->stack);
+  if (mts.n != 1 || !token_is_number (&mts.mts[0].token))
+    {
+      macro_error (me->stack, mts.n > 0 ? &mts.mts[0] : NULL,
+                   _("Macro expression must evaluate to "
+                     "a number (not \"%s\")."), s);
+      free (s);
+      macro_tokens_uninit (&mts);
+      return false;
+    }
+
+  *number = token_number (&mts.mts[0].token);
+  free (s);
+  macro_tokens_uninit (&mts);
+  return true;
+}
+
+static const struct macro_token *
+find_ifend_clause (const struct macro_token *p, const struct macro_token *end)
+{
+  size_t nesting = 0;
+  for (; p < end; p++)
+    {
+      if (p->token.type != T_MACRO_ID)
+        continue;
+
+      if (ss_equals_case (p->token.string, ss_cstr ("!IF")))
+        nesting++;
+      else if (lex_id_match_n (p->token.string, ss_cstr ("!IFEND"), 4))
+        {
+          if (!nesting)
+            return p;
+          nesting--;
+        }
+      else if (lex_id_match_n (p->token.string, ss_cstr ("!ELSE"), 4)
+               && !nesting)
+        return p;
+    }
+  return NULL;
+}
+
+static size_t
+macro_expand_if (const struct macro_token *tokens, size_t n_tokens,
+                 const struct macro_expander *me,
+                 struct macro_tokens *exp)
+{
+  const struct macro_token *p = tokens;
+  const struct macro_token *end = tokens + n_tokens;
+
+  if (p >= end || !ss_equals_case (p->token.string, ss_cstr ("!IF")))
+    return 0;
+
+  p++;
+  char *result = macro_evaluate_expression (&p, end - p, me);
+  if (!result)
+    return 0;
+  bool b = strcmp (result, "0");
+  free (result);
+
+  if (p >= end
+      || p->token.type != T_MACRO_ID
+      || !lex_id_match_n (p->token.string, ss_cstr ("!THEN"), 4))
+    {
+      macro_error (me->stack, p < end ? p : NULL,
+                   _("!THEN expected in macro !IF construct."));
+      return 0;
+    }
+
+  const struct macro_token *start_then = p + 1;
+  const struct macro_token *end_then = find_ifend_clause (start_then, end);
+  if (!end_then)
+    {
+      macro_error (me->stack, NULL,
+                   _("!ELSE or !IFEND expected in macro !IF construct."));
+      return 0;
+    }
+
+  const struct macro_token *start_else, *end_if;
+  if (lex_id_match_n (end_then->token.string, ss_cstr ("!ELSE"), 4))
+    {
+      start_else = end_then + 1;
+      end_if = find_ifend_clause (start_else, end);
+      if (!end_if
+          || !lex_id_match_n (end_if->token.string, ss_cstr ("!IFEND"), 4))
+        {
+          macro_error (me->stack, end_if ? end_if : NULL,
+                       _("!IFEND expected in macro !IF construct."));
+          return 0;
+        }
+    }
+  else
+    {
+      start_else = NULL;
+      end_if = end_then;
+    }
+
+  const struct macro_token *start;
+  size_t n;
+  if (b)
+    {
+      start = start_then;
+      n = end_then - start_then;
+    }
+  else if (start_else)
+    {
+      start = start_else;
+      n = end_if - start_else;
+    }
+  else
+    {
+      start = NULL;
+      n = 0;
+    }
+
+  if (n)
+    {
+      struct macro_expansion_stack stack = {
+        .name = "!IF",
+        .next = me->stack,
+      };
+      struct macro_expander subme = *me;
+      subme.stack = &stack;
+      macro_expand (start, n, &subme, exp);
+    }
+  return (end_if + 1) - tokens;
+}
+
+static size_t
+macro_parse_let (const struct macro_token *tokens, size_t n_tokens,
+                 const struct macro_expander *me)
+{
+  const struct macro_token *p = tokens;
+  const struct macro_token *end = tokens + n_tokens;
+
+  if (p >= end || !ss_equals_case (p->token.string, ss_cstr ("!LET")))
+    return 0;
+  p++;
+
+  if (p >= end || p->token.type != T_MACRO_ID)
+    {
+      macro_error (me->stack, p < end ? p : NULL,
+                   _("Expected macro variable name following !LET."));
+      return 0;
+    }
+  const struct substring var_name = p->token.string;
+  if (is_macro_keyword (var_name)
+      || macro_find_parameter_by_name (me->macro, var_name))
+    {
+      macro_error (me->stack, p < end ? p : NULL,
+                   _("Cannot use argument name or macro keyword "
+                     "\"%.*s\" as !LET variable."),
+                   (int) var_name.length, var_name.string);
+      return 0;
+    }
+  p++;
+
+  if (p >= end || p->token.type != T_EQUALS)
+    {
+      macro_error (me->stack, p < end ? p : NULL,
+                   _("Expected `=' following !LET."));
+      return 0;
+    }
+  p++;
+
+  char *value = macro_evaluate_expression (&p, end - p, me);
+  if (!value)
+    return 0;
+
+  stringi_map_replace_nocopy (me->vars, ss_xstrdup (var_name), value);
+  return p - tokens;
+}
+
+static const struct macro_token *
+find_doend (const struct macro_expansion_stack *stack,
+            const struct macro_token *p, const struct macro_token *end)
+{
+  size_t nesting = 0;
+  for (; p < end; p++)
+    {
+      if (p->token.type != T_MACRO_ID)
+        continue;
+
+      if (ss_equals_case (p->token.string, ss_cstr ("!DO")))
+        nesting++;
+      else if (lex_id_match_n (p->token.string, ss_cstr ("!DOEND"), 4))
+        {
+          if (!nesting)
+            return p;
+          nesting--;
+        }
+    }
+  macro_error (stack, NULL, _("Missing !DOEND."));
+  return NULL;
+}
+
+static size_t
+macro_expand_do (const struct macro_token *tokens, size_t n_tokens,
+                 const struct macro_expander *me,
+                 struct macro_tokens *exp)
+{
+  const struct macro_token *p = tokens;
+  const struct macro_token *end = tokens + n_tokens;
+
+  if (p >= end || !ss_equals_case (p->token.string, ss_cstr ("!DO")))
+    return 0;
+  p++;
+
+  if (p >= end || p->token.type != T_MACRO_ID)
+    {
+      macro_error (me->stack, p < end ? p : NULL,
+                   _("Expected macro variable name following !DO."));
+      return 0;
+    }
+  const struct substring var_name = p->token.string;
+  if (is_macro_keyword (var_name)
+      || macro_find_parameter_by_name (me->macro, var_name))
+    {
+      macro_error (me->stack, p, _("Cannot use argument name or macro "
+                                   "keyword as !DO variable."));
+      return 0;
+    }
+  p++;
+
+  struct macro_expansion_stack substack = {
+    .name = "!DO",
+    .next = me->stack,
+  };
+  bool break_ = false;
+  struct macro_expander subme = *me;
+  subme.break_ = &break_;
+  subme.stack = &substack;
+
+  int miterate = settings_get_miterate ();
+  if (p < end && p->token.type == T_MACRO_ID
+      && ss_equals_case (p->token.string, ss_cstr ("!IN")))
+    {
+      p++;
+      char *list = macro_evaluate_expression (&p, end - p, &subme);
+      if (!list)
+        return 0;
+
+      struct macro_tokens items = { .n = 0 };
+      macro_tokens_from_string__ (&items, ss_cstr (list), me->segmenter_mode,
+                                  me->stack);
+      free (list);
+
+      const struct macro_token *do_end = find_doend (subme.stack, p, end);
+      if (!do_end)
+        {
+          macro_tokens_uninit (&items);
+          return 0;
+        }
+
+      for (size_t i = 0; i < items.n && !break_; i++)
+        {
+          if (i >= miterate)
+            {
+              macro_error (&substack, NULL,
+                           _("!DO loop over list exceeded "
+                             "maximum number of iterations %d.  "
+                             "(Use SET MITERATE to change the limit.)"),
+                           miterate);
+              break;
+            }
+          stringi_map_replace_nocopy (me->vars, ss_xstrdup (var_name),
+                                      ss_xstrdup (items.mts[i].syntax));
+
+          macro_expand (p, do_end - p, &subme, exp);
+        }
+      return do_end - tokens + 1;
+    }
+  else if (p < end && p->token.type == T_EQUALS)
+    {
+      p++;
+      double first;
+      if (!macro_evaluate_number (&p, end - p, &subme, &first))
+        return 0;
+
+      if (p >= end || p->token.type != T_MACRO_ID
+          || !ss_equals_case (p->token.string, ss_cstr ("!TO")))
+        {
+          macro_error (subme.stack, p < end ? p : NULL,
+                       _("Expected !TO in numerical !DO loop."));
+          return 0;
+        }
+      p++;
+
+      double last;
+      if (!macro_evaluate_number (&p, end - p, &subme, &last))
+        return 0;
+
+      double by = 1.0;
+      if (p < end && p->token.type == T_MACRO_ID
+          && ss_equals_case (p->token.string, ss_cstr ("!BY")))
+        {
+          p++;
+          if (!macro_evaluate_number (&p, end - p, &subme, &by))
+            return 0;
+
+          if (by == 0.0)
+            {
+              macro_error (subme.stack, NULL, _("!BY value cannot be zero."));
+              return 0;
+            }
+        }
+
+      const struct macro_token *do_end = find_doend (subme.stack, p, end);
+      if (!do_end)
+        return 0;
+      if ((by > 0 && first <= last) || (by < 0 && first >= last))
+        {
+          int i = 0;
+          for (double index = first;
+               by > 0 ? (index <= last) : (index >= last) && !break_;
+               index += by)
+            {
+              if (i++ > miterate)
+                {
+                  macro_error (subme.stack, NULL,
+                               _("Numerical !DO loop exceeded "
+                                 "maximum number of iterations %d.  "
+                                 "(Use SET MITERATE to change the limit.)"),
+                               miterate);
+                  break;
+                }
+
+              char index_s[DBL_BUFSIZE_BOUND];
+              c_dtoastr (index_s, sizeof index_s, 0, 0, index);
+              stringi_map_replace_nocopy (me->vars, ss_xstrdup (var_name),
+                                          xstrdup (index_s));
+
+              macro_expand (p, do_end - p, &subme, exp);
+            }
+        }
+
+      return do_end - tokens + 1;
+    }
+  else
+    {
+      macro_error (me->stack, p < end ? p : NULL,
+                   _("Expected `=' or !IN in !DO loop."));
+      return 0;
+    }
+}
+
+static void
+macro_expand_arg (const struct macro_expander *me, size_t idx,
+                  struct macro_tokens *exp)
+{
+  const struct macro_param *param = &me->macro->params[idx];
+  const struct macro_tokens *arg = me->args[idx];
+
+  if (*me->expand && param->expand_arg)
+    {
+      struct stringi_map vars = STRINGI_MAP_INITIALIZER (vars);
+      struct macro_expansion_stack stack = {
+        .name = param->name,
+        .next = me->stack,
+      };
+      struct macro_expander subme = {
+        .macros = me->macros,
+        .macro = NULL,
+        .args = NULL,
+        .segmenter_mode = me->segmenter_mode,
+        .expand = me->expand,
+        .break_ = NULL,
+        .vars = &vars,
+        .nesting_countdown = me->nesting_countdown,
+        .stack = &stack,
+      };
+      macro_expand (arg->mts, arg->n, &subme, exp);
+      stringi_map_destroy (&vars);
+    }
+  else
+    for (size_t i = 0; i < arg->n; i++)
+      macro_tokens_add (exp, &arg->mts[i]);
+}
+
+static size_t
+macro_expand__ (const struct macro_token *mts, size_t n,
+                const struct macro_expander *me,
+                struct macro_tokens *exp)
+{
+  const struct token *token = &mts[0].token;
+
+  /* Recursive macro calls. */
+  if (*me->expand)
+    {
+      struct macro_call *submc;
+      int n_call = macro_call_create (me->macros, token, &submc);
+      for (size_t j = 1; !n_call; j++)
+        {
+          const struct macro_token endcmd
+            = { .token = { .type = T_ENDCMD } };
+          n_call = macro_call_add (submc, j < n ? &mts[j] : &endcmd);
+        }
+      if (n_call > 0)
+        {
+          struct stringi_map vars = STRINGI_MAP_INITIALIZER (vars);
+          struct macro_expansion_stack stack = {
+            .name = submc->macro->name,
+            .file_name = submc->macro->file_name,
+            .first_line = submc->macro->first_line,
+            .last_line = submc->macro->last_line,
+            .next = me->stack,
+          };
+          struct macro_expander subme = {
+            .macros = submc->macros,
+            .macro = submc->macro,
+            .args = submc->args,
+            .segmenter_mode = me->segmenter_mode,
+            .expand = me->expand,
+            .break_ = NULL,
+            .vars = &vars,
+            .nesting_countdown = me->nesting_countdown - 1,
+            .stack = &stack,
+          };
+          const struct macro_tokens *body = &submc->macro->body;
+          macro_expand (body->mts, body->n, &subme, exp);
+          macro_call_destroy (submc);
+          stringi_map_destroy (&vars);
+          return n_call;
+        }
+
+      macro_call_destroy (submc);
+    }
+
+  if (token->type != T_MACRO_ID)
+    {
+      macro_tokens_add (exp, &mts[0]);
+      return 1;
+    }
+
+  /* Parameters. */
+  if (me->macro)
+    {
+      const struct macro_param *param = macro_find_parameter_by_name (
+        me->macro, token->string);
+      if (param)
+        {
+          macro_expand_arg (me, param - me->macro->params, exp);
+          return 1;
+        }
+      else if (is_bang_star (mts, n))
+        {
+          for (size_t j = 0; j < me->macro->n_params; j++)
+            macro_expand_arg (me, j, exp);
+          return 2;
+        }
+    }
+
+  /* Variables set by !DO or !LET. */
+  const char *var = stringi_map_find__ (me->vars, token->string.string,
+                                        token->string.length);
+  if (var)
+    {
+      macro_tokens_from_string__ (exp, ss_cstr (var),
+                                  me->segmenter_mode, me->stack);
+      return 1;
+    }
+
+  /* Macro functions. */
+  struct string function_output = DS_EMPTY_INITIALIZER;
+  size_t n_function = expand_macro_function (me, mts, n, &function_output);
+  if (n_function)
+    {
+      macro_tokens_from_string__ (exp, function_output.ss,
+                                  me->segmenter_mode, me->stack);
+      ds_destroy (&function_output);
+
+      return n_function;
+    }
+
+  size_t n_if = macro_expand_if (mts, n, me, exp);
+  if (n_if > 0)
+    return n_if;
+
+  size_t n_let = macro_parse_let (mts, n, me);
+  if (n_let > 0)
+    return n_let;
+
+  size_t n_do = macro_expand_do (mts, n, me, exp);
+  if (n_do > 0)
+    return n_do;
+
+  if (lex_id_match_n (token->string, ss_cstr ("!break"), 4))
+    {
+      if (me->break_)
+        *me->break_ = true;
+      else
+        macro_error (me->stack, &mts[0], _("!BREAK outside !DO."));
+    }
+  else if (lex_id_match_n (token->string, ss_cstr ("!onexpand"), 4))
+    *me->expand = true;
+  else if (lex_id_match_n (token->string, ss_cstr ("!offexpand"), 4))
+    *me->expand = false;
+  else
+    macro_tokens_add (exp, &mts[0]);
+  return 1;
+}
+
+static void
+macro_expand (const struct macro_token *mts, size_t n,
+              const struct macro_expander *me,
+              struct macro_tokens *exp)
+{
+  if (me->nesting_countdown <= 0)
+    {
+      macro_error (me->stack, NULL, _("Maximum nesting level %d exceeded.  "
+                                      "(Use SET MNEST to change the limit.)"),
+                   settings_get_mnest ());
+      for (size_t i = 0; i < n; i++)
+        macro_tokens_add (exp, &mts[i]);
+      return;
+    }
+
+  for (size_t i = 0; i < n; )
+    {
+      if (me->break_ && *me->break_)
+        break;
+
+      size_t consumed = macro_expand__ (&mts[i], n - i, me, exp);
+      assert (consumed > 0 && i + consumed <= n);
+      i += consumed;
+    }
+}
+
+void
+macro_call_expand (struct macro_call *mc, enum segmenter_mode segmenter_mode,
+                   struct macro_tokens *exp)
+{
+  assert (mc->state == MC_FINISHED);
+
+  bool expand = true;
+  struct stringi_map vars = STRINGI_MAP_INITIALIZER (vars);
+  struct macro_expansion_stack stack = {
+    .name = mc->macro->name,
+    .file_name = mc->macro->file_name,
+    .first_line = mc->macro->first_line,
+    .last_line = mc->macro->last_line,
+  };
+  struct macro_expander me = {
+    .macros = mc->macros,
+    .macro = mc->macro,
+    .args = mc->args,
+    .segmenter_mode = segmenter_mode,
+    .expand = &expand,
+    .break_ = NULL,
+    .vars = &vars,
+    .nesting_countdown = settings_get_mnest (),
+    .stack = &stack,
+  };
+
+  const struct macro_tokens *body = &mc->macro->body;
+  macro_expand (body->mts, body->n, &me, exp);
+
+  stringi_map_destroy (&vars);
+}
+
diff --git a/src/language/lexer/macro.h b/src/language/lexer/macro.h
new file mode 100644 (file)
index 0000000..40e8d08
--- /dev/null
@@ -0,0 +1,142 @@
+/* PSPP - a program for statistical analysis.
+   Copyright (C) 2021 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>. */
+
+#ifndef MACRO_H
+#define MACRO_H 1
+
+#include <stdbool.h>
+#include <stddef.h>
+
+#include "libpspp/hmap.h"
+#include "libpspp/str.h"
+#include "language/lexer/segment.h"
+#include "language/lexer/token.h"
+
+/* A token along with the syntax that was tokenized to produce it.  The syntax
+   allows the token to be turned back into syntax accurately. */
+struct macro_token
+  {
+    struct token token;
+    struct substring syntax;
+  };
+
+void macro_token_copy (struct macro_token *, const struct macro_token *);
+void macro_token_uninit (struct macro_token *);
+
+void macro_token_to_syntax (struct macro_token *, struct string *);
+
+bool is_macro_keyword (struct substring);
+\f
+/* A dynamic array of macro tokens.
+
+   The syntax for the tokens doesn't include white space, etc. between them. */
+struct macro_tokens
+  {
+    struct macro_token *mts;
+    size_t n;
+    size_t allocated;
+  };
+
+void macro_tokens_copy (struct macro_tokens *, const struct macro_tokens *);
+void macro_tokens_uninit (struct macro_tokens *);
+struct macro_token *macro_tokens_add_uninit (struct macro_tokens *);
+void macro_tokens_add (struct macro_tokens *, const struct macro_token *);
+
+void macro_tokens_from_string (struct macro_tokens *, const struct substring,
+                               enum segmenter_mode);
+
+void macro_tokens_to_syntax (struct macro_tokens *, struct string *,
+                             size_t *ofs, size_t *len);
+
+void macro_tokens_print (const struct macro_tokens *, FILE *);
+\f
+/* A parameter to a macro. */
+struct macro_param
+  {
+    bool positional;            /* Is this a positional parameter? */
+    char *name;                 /* "!1" or "!name". */
+    struct macro_tokens def;    /* Default expansion. */
+    bool expand_arg;            /* Macro-expand the argument? */
+
+    enum
+      {
+        ARG_N_TOKENS,
+        ARG_CHAREND,
+        ARG_ENCLOSE,
+        ARG_CMDEND
+      }
+    arg_type;
+    union
+      {
+        int n_tokens;            /* ARG_N_TOKENS. */
+        struct token charend;    /* ARG_CHAREND. */
+        struct token enclose[2]; /* ARG_ENCLOSE. */
+      };
+  };
+
+/* A macro. */
+struct macro
+  {
+    struct hmap_node hmap_node; /* Indexed by 'name'. */
+    char *name;
+
+    /* Source code location of macro definition, for error reporting. */
+    char *file_name;
+    int first_line;
+    int last_line;
+
+    /* Parameters. */
+    struct macro_param *params;
+    size_t n_params;
+
+    /* Body. */
+    struct macro_tokens body;
+  };
+
+void macro_destroy (struct macro *);
+\f
+/* A collection of macros. */
+struct macro_set
+  {
+    struct hmap macros;
+  };
+
+struct macro_set *macro_set_create (void);
+void macro_set_destroy (struct macro_set *);
+const struct macro *macro_set_find (const struct macro_set *,
+                                    const char *);
+void macro_set_add (struct macro_set *, struct macro *);
+
+static inline bool
+macro_set_is_empty (const struct macro_set *set)
+{
+  return hmap_is_empty (&set->macros);
+}
+\f
+/* Parsing and expanding macro calls. */
+
+struct macro_call;
+
+int macro_call_create (const struct macro_set *, const struct token *,
+                      struct macro_call **);
+int macro_call_add (struct macro_call *, const struct macro_token *);
+
+void macro_call_expand (struct macro_call *, enum segmenter_mode segmenter_mode,
+                        struct macro_tokens *);
+
+void macro_call_destroy (struct macro_call *);
+
+#endif /* macro.h */
index a0a71e9cee7d4481d0fd143d1e56bf754c4b0edb..323bdf3fa51e79d35c375e8fc6a4dde22431a979 100644 (file)
@@ -59,7 +59,7 @@ parse_title (struct lexer *lexer, void (*set_title) (const char *))
 
       /* Get the raw representation of all the tokens, including any space
          between them, and use it as the title. */
-      char *title = ss_xstrdup (lex_next_representation (lexer, 0, n - 1));
+      char *title = lex_next_representation (lexer, 0, n - 1);
       set_title (title);
       free (title);
 
index bbba1c5506e9cdb1dad009d4eeedce06401e7f24..f1afc8fe3050481df753ff4b93bd03ae22fb9d39 100644 (file)
@@ -105,12 +105,18 @@ msg_set_handler (void (*handler) (const struct msg *, void *aux), void *aux)
 \f
 /* msg_location. */
 
+void
+msg_location_uninit (struct msg_location *loc)
+{
+  free (loc->file_name);
+}
+
 void
 msg_location_destroy (struct msg_location *loc)
 {
   if (loc)
     {
-      free (loc->file_name);
+      msg_location_uninit (loc);
       free (loc);
     }
 }
@@ -197,6 +203,31 @@ msg_location_format (const struct msg_location *loc, struct string *s)
     }
 }
 \f
+/* msg_stack */
+
+void
+msg_stack_destroy (struct msg_stack *stack)
+{
+  if (stack)
+    {
+      msg_location_uninit (&stack->location);
+      free (stack->description);
+      free (stack);
+    }
+}
+
+struct msg_stack *
+msg_stack_dup (const struct msg_stack *src)
+{
+  struct msg_stack *dst = xmalloc (sizeof *src);
+  *dst = (struct msg_stack) {
+    .location = src->location,
+    .description = xstrdup_if_nonnull (src->description),
+  };
+  dst->location.file_name = xstrdup_if_nonnull (dst->location.file_name);
+  return dst;
+}
+\f
 /* Working with messages. */
 
 const char *
@@ -218,10 +249,16 @@ msg_severity_to_string (enum msg_severity severity)
 struct msg *
 msg_dup (const struct msg *src)
 {
+  struct msg_stack **ms = xmalloc (src->n_stack * sizeof *ms);
+  for (size_t i = 0; i < src->n_stack; i++)
+    ms[i] = msg_stack_dup (src->stack[i]);
+
   struct msg *dst = xmalloc (sizeof *dst);
   *dst = (struct msg) {
     .category = src->category,
     .severity = src->severity,
+    .stack = ms,
+    .n_stack = src->n_stack,
     .location = msg_location_dup (src->location),
     .command_name = xstrdup_if_nonnull (src->command_name),
     .text = xstrdup (src->text),
@@ -239,6 +276,9 @@ msg_destroy (struct msg *m)
 {
   if (m)
     {
+      for (size_t i = 0; i < m->n_stack; i++)
+        msg_stack_destroy (m->stack[i]);
+      free (m->stack);
       msg_location_destroy (m->location);
       free (m->text);
       free (m->command_name);
@@ -253,6 +293,16 @@ msg_to_string (const struct msg *m)
 
   ds_init_empty (&s);
 
+  for (size_t i = 0; i < m->n_stack; i++)
+    {
+      const struct msg_stack *ms = m->stack[i];
+      if (!msg_location_is_empty (&ms->location))
+        {
+          msg_location_format (&ms->location, &s);
+          ds_put_cstr (&s, ": ");
+        }
+      ds_put_format (&s, "%s\n", ms->description);
+    }
   if (m->category != MSG_C_GENERAL && !msg_location_is_empty (m->location))
     {
       msg_location_format (m->location, &s);
index 36aae9c5d13137d790493ae6ac102ec5cc3ba600..d403b696539a4eabe07e9c0a5e520a717d6c37f3 100644 (file)
@@ -19,6 +19,7 @@
 
 #include <stdarg.h>
 #include <stdbool.h>
+#include <stddef.h>
 #include "libpspp/compiler.h"
 
 struct string;
@@ -80,18 +81,30 @@ struct msg_location
     int last_column;            /* 1-based exclusive last column (0=none). */
   };
 
+void msg_location_uninit (struct msg_location *);
 void msg_location_destroy (struct msg_location *);
 struct msg_location *msg_location_dup (const struct msg_location *);
 
 bool msg_location_is_empty (const struct msg_location *);
 void msg_location_format (const struct msg_location *, struct string *);
 
+struct msg_stack
+  {
+    struct msg_location location;
+    char *description;
+  };
+
+void msg_stack_destroy (struct msg_stack *);
+struct msg_stack *msg_stack_dup (const struct msg_stack *);
+
 /* A message. */
 struct msg
   {
     enum msg_category category; /* Message category. */
     enum msg_severity severity; /* Message severity. */
     struct msg_location *location; /* Code location. */
+    struct msg_stack **stack;
+    size_t n_stack;
     char *command_name;         /* Name of erroneous command, or NULL.  */
     char *text;                 /* Error text. */
   };
index 1def93fdab623ef8fe4bbe96930f689df5977af6..f43bd5dc11556c2ed05fade994654c7c8d989860 100644 (file)
@@ -221,6 +221,8 @@ output_msg (const struct msg *m_, void *lexer_)
   struct msg m = {
     .category = m_->category,
     .severity = m_->severity,
+    .stack = m_->stack,
+    .n_stack = m_->n_stack,
     .location = (m_->location ? m_->location
                  : lexer ? lex_get_lines (lexer, 0, 0)
                  : NULL),
index ec81e5288140196c5dbd368faf8c00d80e8480d7..4de61417b2ef7cf95b8898bd50abded0f386abfd 100644 (file)
@@ -339,6 +339,7 @@ TESTSUITE_AT = \
        tests/data/sys-file.at \
        tests/data/encrypted-file.at \
        tests/language/command.at \
+       tests/language/control/define.at \
        tests/language/control/do-if.at \
        tests/language/control/do-repeat.at \
        tests/language/control/loop.at \
diff --git a/tests/language/control/define.at b/tests/language/control/define.at
new file mode 100644 (file)
index 0000000..2a4f58c
--- /dev/null
@@ -0,0 +1,1686 @@
+dnl PSPP - a program for statistical analysis.
+dnl Copyright (C) 2017 Free Software Foundation, Inc.
+dnl
+dnl This program is free software: you can redistribute it and/or modify
+dnl it under the terms of the GNU General Public License as published by
+dnl the Free Software Foundation, either version 3 of the License, or
+dnl (at your option) any later version.
+dnl
+dnl This program is distributed in the hope that it will be useful,
+dnl but WITHOUT ANY WARRANTY; without even the implied warranty of
+dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+dnl GNU nGeneral Public License for more details.
+dnl
+dnl You should have received a copy of the GNU General Public License
+dnl along with this program.  If not, see <http://www.gnu.org/licenses/>.
+dnl
+AT_BANNER([DEFINE])
+
+m4_define([PSPP_CHECK_MACRO_EXPANSION],
+  [AT_SETUP([macro expansion - $1])
+   AT_KEYWORDS([m4_bpatsubst([$1], [!], [])])
+   AT_DATA([define.sps], [$2
+DEBUG EXPAND.
+$3
+])
+   AT_CAPTURE_FILE([define.sps])
+   AT_DATA([expout], [$4
+])
+   AT_CHECK([pspp --testing-mode define.sps | sed '/^$/d'], [$6], [expout])
+   AT_CLEANUP])
+
+AT_SETUP([simple macro expansion])
+AT_DATA([define.sps], [dnl
+DEFINE !macro()
+a b c d
+e f g h.
+i j k l
+1,2,3,4.
+5+6+7.
+m(n,o).
+"a" "b" "c" 'a' 'b' 'c'.
+"x "" y".
+!ENDDEFINE.
+DEBUG EXPAND.
+!macro
+])
+AT_CHECK([pspp --testing-mode define.sps], [0], [dnl
+a b c d e f g h.
+i j k l 1, 2, 3, 4.
+5 + 6 + 7.
+m(n, o).
+"a" "b" "c" 'a' 'b' 'c'.
+"x "" y".
+])
+AT_CLEANUP
+
+PSPP_CHECK_MACRO_EXPANSION([one !TOKENS(1) positional argument],
+  [DEFINE !t1(!positional !tokens(1)) t1 (!1) !ENDDEFINE.],
+  [!t1 a.
+!t1 b.
+!t1 a b.],
+  [t1(a)
+t1(b)
+t1(a)
+note: unexpanded token "b"])
+
+AT_SETUP([macro expansion with positional arguments])
+AT_DATA([define.sps], [dnl
+DEFINE !title(!positional !tokens(1)) !1 !ENDDEFINE.
+DEFINE !t1(!positional !tokens(1)) t1 (!1) !ENDDEFINE.
+DEFINE !t2(!positional !tokens(2)) t2 (!1) !ENDDEFINE.
+
+DEFINE !ce(!positional !charend('/')) ce (!1) !ENDDEFINE.
+DEFINE !ce2(!positional !charend('(')
+           /!positional !charend(')'))
+ce2 (!1, !2)
+!ENDDEFINE.
+
+DEFINE !e(!positional !enclose('{','}')) e (!1) !ENDDEFINE.
+
+DEFINE !cmd(!positional !cmdend) cmd(!1) !ENDDEFINE.
+DEFINE !cmd2(!positional !cmdend
+            /!positional !tokens(1))
+cmd2(!1, !2)
+!ENDDEFINE.
+
+DEFINE !p(!positional !tokens(1)
+         /!positional !tokens(1)
+        /!positional !tokens(1))
+p(!1, !2, !3)(!*)
+!ENDDEFINE.
+
+DEBUG EXPAND.
+!title "!TOKENS(1) argument."
+!t1 a.
+!t1 b.
+!t1 a b.
+
+!title "!TOKENS(2) argument."
+!t2 a b.
+!t2 b c d.
+
+!title "!CHAREND argument."
+!ce/.
+!ce x/.
+!ce x y/.
+!ce x y z/.
+
+!title "Two !CHAREND arguments."
+!ce2 x(y).
+!ce2 1 2 3 4().
+
+!title "!ENCLOSE argument."
+!e {}.
+!e {a}.
+!e {a b}.
+
+!title "!CMDEND argument."
+!cmd 1 2 3 4.
+!cmd2 5 6.
+7.
+
+!title "Three !TOKENS(1) arguments."
+!p a b c.
+!p 1 -2 -3.
+])
+AT_CHECK([pspp --testing-mode define.sps], [0], [dnl
+"!TOKENS(1) argument."
+
+t1(a)
+
+t1(b)
+
+t1(a)
+
+note: unexpanded token "b"
+
+"!TOKENS(2) argument."
+
+t2(a b)
+
+t2(b c)
+
+note: unexpanded token "d"
+
+"!CHAREND argument."
+
+ce( )
+
+ce(x)
+
+ce(x y)
+
+ce(x y z)
+
+"Two !CHAREND arguments."
+
+ce2(x, y)
+
+ce2(1 2 3 4, )
+
+"!ENCLOSE argument."
+
+e( )
+
+e(a)
+
+e(a b)
+
+"!CMDEND argument."
+
+cmd(1 2 3 4)
+
+cmd2(5 6, 7)
+
+"Three !TOKENS(1) arguments."
+
+p(a, b, c) (a b c)
+
+p(1, -2, -3) (1 -2 -3)
+])
+AT_CLEANUP
+
+AT_SETUP([macro expansion with positional arguments - negative])
+AT_DATA([define.sps], [dnl
+DEFINE !title(!positional !tokens(1)) !1 !ENDDEFINE.
+DEFINE !p(!positional !tokens(1)
+         /!positional !tokens(1)
+        /!positional !tokens(1))
+(!1, !2, !3)
+!ENDDEFINE.
+
+DEFINE !ce(!positional !charend('/')) ce(!1) !ENDDEFINE.
+
+DEFINE !enc1(!positional !enclose('{', '}')) enc1(!1) !ENDDEFINE.
+DEBUG EXPAND.
+!title "Too few tokens for !TOKENS."
+!p a b.
+!p a.
+!p.
+
+!title "Missing charend delimiter."
+!ce a b c.
+
+!title "Missing start delimiter."
+!enc1 a b c.
+
+!title "Missing end delimiter."
+!enc1{a b c.
+])
+AT_CHECK([pspp --testing-mode define.sps], [1], [dnl
+"Too few tokens for !TOKENS."
+
+define.sps:13: error: DEBUG EXPAND: Unexpected end of command reading
+argument !3 to macro !p.
+
+note: unexpanded token "!p"
+
+note: unexpanded token "a"
+
+note: unexpanded token "b"
+
+define.sps:14: error: DEBUG EXPAND: Unexpected end of command reading
+argument !2 to macro !p.
+
+note: unexpanded token "!p"
+
+note: unexpanded token "a"
+
+define.sps:15: error: DEBUG EXPAND: Unexpected end of command reading
+argument !1 to macro !p.
+
+note: unexpanded token "!p"
+
+"Missing charend delimiter."
+
+define.sps:18: error: DEBUG EXPAND: Unexpected end of command reading
+argument !1 to macro !ce.
+
+note: unexpanded token "!ce"
+
+note: unexpanded token "a"
+
+note: unexpanded token "b"
+
+note: unexpanded token "c"
+
+"Missing start delimiter."
+
+define.sps:21: error: DEBUG EXPAND: Found `a' while expecting `{' reading
+argument !1 to macro !enc1.
+
+note: unexpanded token "!enc1"
+
+note: unexpanded token "a"
+
+note: unexpanded token "b"
+
+note: unexpanded token "c"
+
+"Missing end delimiter."
+
+define.sps:24: error: DEBUG EXPAND: Unexpected end of command reading
+argument !1 to macro !enc1.
+
+note: unexpanded token "!enc1"
+
+note: unexpanded token "{"
+
+note: unexpanded token "a"
+
+note: unexpanded token "b"
+
+note: unexpanded token "c"
+])
+AT_CLEANUP
+
+AT_SETUP([keyword macro argument name with ! prefix])
+AT_DATA([define.sps], [dnl
+DEFINE !macro(!x=!TOKENS(1).
+])
+AT_CHECK([pspp -O format=csv define.sps], [1], [dnl
+"define.sps:1.15-1.16: error: DEFINE: Syntax error at `!x': Keyword macro parameter must be named in definition without ""!"" prefix."
+])
+AT_CLEANUP
+
+AT_SETUP([reserved macro keyword argument name])
+AT_DATA([define.sps], [dnl
+DEFINE !macro(if=!TOKENS(1).
+])
+AT_CHECK([pspp -O format=csv define.sps], [1], [dnl
+"define.sps:1.15-1.16: error: DEFINE: Syntax error at `if': Cannot use macro keyword ""if"" as an argument name."
+])
+AT_CLEANUP
+
+PSPP_CHECK_MACRO_EXPANSION([one !TOKENS(1) keyword argument],
+  [DEFINE !k(arg1 = !TOKENS(1)) k(!arg1) !ENDDEFINE.],
+  [!k arg1=x.
+!k arg1=x y.
+!k.],
+  [k(x)
+k(x)
+note: unexpanded token "y"
+k( )])
+
+PSPP_CHECK_MACRO_EXPANSION([one !TOKENS(1) keyword argument - negative],
+  [DEFINE !k(arg1 = !TOKENS(1)) k(!arg1) !ENDDEFINE.],
+  [!k arg1.
+!k arg1=.], [dnl
+define.sps:3: error: DEBUG EXPAND: Found `.' while expecting `=' reading
+argument !arg1 to macro !k.
+note: unexpanded token "!k"
+note: unexpanded token "arg1"
+define.sps:4: error: DEBUG EXPAND: Unexpected end of command reading argument !
+arg1 to macro !k.
+note: unexpanded token "!k"
+note: unexpanded token "arg1"
+note: unexpanded token "="], [1])
+
+PSPP_CHECK_MACRO_EXPANSION([!CHAREND('/') keyword arguments], [dnl
+DEFINE !k(arg1 = !CHAREND('/')
+         /arg2 = !CHAREND('/'))
+k(!arg1, !arg2)
+!ENDDEFINE.],
+  [!k arg1=x/ arg2=y/.
+!k arg1=x/.
+!k arg2=y/.
+!k.],
+  [k(x, y)
+k(x, )
+k(, y)
+k(, )])
+
+PSPP_CHECK_MACRO_EXPANSION([!CHAREND('/') keyword arguments - negative], [dnl
+DEFINE !k(arg1 = !CHAREND('/')
+         /arg2 = !CHAREND('/'))
+k(!arg1, !arg2)
+!ENDDEFINE.],
+  [!k arg1.
+!k arg1=.
+!k arg1=x.
+!k arg1=x/ arg2=y.],
+  [define.sps:6: error: DEBUG EXPAND: Found `.' while expecting `=' reading
+argument !arg1 to macro !k.
+note: unexpanded token "!k"
+note: unexpanded token "arg1"
+define.sps:7: error: DEBUG EXPAND: Unexpected end of command reading argument !
+arg1 to macro !k.
+note: unexpanded token "!k"
+note: unexpanded token "arg1"
+note: unexpanded token "="
+define.sps:8: error: DEBUG EXPAND: Unexpected end of command reading argument !
+arg1 to macro !k.
+note: unexpanded token "!k"
+note: unexpanded token "arg1"
+note: unexpanded token "="
+note: unexpanded token "x"
+define.sps:9: error: DEBUG EXPAND: Unexpected end of command reading argument !
+arg2 to macro !k.
+note: unexpanded token "!k"
+note: unexpanded token "arg1"
+note: unexpanded token "="
+note: unexpanded token "x"
+note: unexpanded token "/"
+note: unexpanded token "arg2"
+note: unexpanded token "="
+note: unexpanded token "y"])
+
+PSPP_CHECK_MACRO_EXPANSION([default keyword arguments],
+  [DEFINE !k(arg1 = !DEFAULT(a b c) !CMDEND) k(!arg1) !ENDDEFINE],
+  [!k arg1=x.
+!k],
+  [k(x)
+k(a b c)])
+
+dnl Keep this test in sync with the examples for !BLANKS in the manual.
+PSPP_CHECK_MACRO_EXPANSION([!BLANKS],
+  [DEFINE !b()
+!BLANKS(0).
+!QUOTE(!BLANKS(0)).
+!BLANKS(1).
+!QUOTE(!BLANKS(1)).
+!BLANKS(2).
+!QUOTE(!BLANKS(2)).
+!BLANKS(5).
+!QUOTE(!BLANKS(5)).
+!ENDDEFINE],
+  [!b.],
+  [.
+''.
+.
+' '.
+.
+'  '.
+.
+'     '.])
+
+dnl Keep this test in sync with the examples for !CONCAT in the manual.
+PSPP_CHECK_MACRO_EXPANSION([!CONCAT],
+  [DEFINE !c()
+!CONCAT(x, y).
+!CONCAT('x', 'y').
+!CONCAT(12, 34).
+!CONCAT(!NULL, 123).
+!CONCAT(x, 0).
+!CONCAT(x, 0, y).
+!CONCAT(0, x).
+!CONCAT(0, x, y).
+!ENDDEFINE],
+  [!c.],
+  [xy.
+xy.
+1234.
+123.
+x0.
+x0y.
+0 x.
+0 xy.])
+
+dnl Keep this test in sync with the examples for !EVAL in the manual.
+PSPP_CHECK_MACRO_EXPANSION([!EVAL],
+  [DEFINE !vars() a b c !ENDDEFINE.
+DEFINE !e()
+!vars.
+!QUOTE(!vars).
+!EVAL(!vars).
+!QUOTE(!EVAL(!vars)).
+!ENDDEFINE
+DEFINE !e2(!positional !enclose('(',')'))
+!1.
+!QUOTE(!1).
+!EVAL(!1).
+!QUOTE(!EVAL(!1)).
+!ENDDEFINE],
+  [!e.
+!e2(!vars)],
+  [a b c.
+'!vars'.
+a b c.
+'a b c'.
+a b c.
+'!vars'.
+a b c.
+'a b c'.])
+
+dnl Keep this test in sync with the examples for !HEAD in the manual.
+PSPP_CHECK_MACRO_EXPANSION([!HEAD],
+  [DEFINE !h()
+!HEAD('a b c').
+!HEAD('a').
+!HEAD(!NULL).
+!HEAD('').
+!ENDDEFINE],
+  [!h.],
+  [a.
+a.
+.
+.])
+
+dnl Keep this test in sync with the examples for !TAIL in the manual.
+PSPP_CHECK_MACRO_EXPANSION([!TAIL],
+  [DEFINE !t()
+!TAIL('a b c').
+!TAIL('a').
+!TAIL(!NULL).
+!TAIL('').
+!ENDDEFINE],
+  [!t.],
+  [b c.
+.
+.
+.])
+
+dnl Keep this test in sync with the examples for !INDEX in the manual.
+PSPP_CHECK_MACRO_EXPANSION([!INDEX],
+  [DEFINE !i()
+!INDEX(banana, an).
+!INDEX(banana, nan).
+!INDEX(banana, apple).
+!INDEX("banana", nan).
+!INDEX("banana", "nan").
+!INDEX(!UNQUOTE("banana"), !UNQUOTE("nan")).
+!ENDDEFINE],
+  [!i.],
+  [2.
+3.
+0.
+4.
+0.
+3.])
+
+dnl Keep this test in sync with the examples for !LENGTH in the manual.
+PSPP_CHECK_MACRO_EXPANSION([!LENGTH],
+  [DEFINE !l()
+!LENGTH(123).
+!LENGTH(123.00).
+!LENGTH( 123 ).
+!LENGTH("123").
+!LENGTH(xyzzy).
+!LENGTH("xyzzy").
+!LENGTH("xy""zzy").
+!LENGTH(!UNQUOTE("xyzzy")).
+!LENGTH(!UNQUOTE("xy""zzy")).
+!LENGTH(!NULL).
+!ENDDEFINE.
+DEFINE !la(!positional !enclose('(',')'))
+!LENGTH(!1).
+!ENDDEFINE.],
+  [!l.
+!la(a b c).
+!la().],
+  [3.
+6.
+3.
+5.
+5.
+7.
+9.
+5.
+6.
+0.
+5.
+0.])
+
+dnl Keep this test in sync with the examples for !SUBSTR in the manual.
+PSPP_CHECK_MACRO_EXPANSION([!SUBSTR],
+  [DEFINE !s()
+!SUBSTR(banana, 3).
+!SUBSTR(banana, 3, 3).
+!SUBSTR("banana", 1, 3).
+!SUBSTR(!UNQUOTE("banana"), 3).
+!SUBSTR("banana", 3, 3).
+!SUBSTR(banana, 3, 0).
+!SUBSTR(banana, 3, 10).
+!SUBSTR(banana, 10, 3).
+!ENDDEFINE.],
+  [!s.],
+  [define.sps:1-10: At `"ba' in the expansion of `!s',dnl "
+
+define.sps:12: error: DEBUG EXPAND: Unterminated string constant.
+nana.
+nan.
+.
+nana.
+ana.
+.
+nana.
+.])
+
+dnl Keep this test in sync with the examples for !UPCASE in the manual.
+PSPP_CHECK_MACRO_EXPANSION([!UPCASE],
+  [DEFINE !u()
+!UPCASE(freckle).
+!UPCASE('freckle').
+!UPCASE('a b c').
+!UPCASE('A B C').
+!ENDDEFINE.],
+  [!u.],
+  [FRECKLE.
+FRECKLE.
+A B C.
+A B C.])
+
+
+dnl !* is implemented separately inside and outside function arguments
+dnl so this test makes sure to include both.
+PSPP_CHECK_MACRO_EXPANSION([!*], [dnl
+DEFINE !m(!POSITIONAL !TOKENS(1)
+         /!POSITIONAL !TOKENS(1))
+!*/
+!LENGTH(!*)/
+!SUBSTR(!*, 3)/
+!QUOTE(!*).
+!ENDDEFINE.],
+  [!m 123 b
+!m 2 3
+!m '' 'b'.
+], [123 b / 5 / 3 b / '123 b'.
+2 3 / 3 / 3 / '2 3'.
+'' 'b' / 6 / 'b' / ''''' ''b'''.])
+
+AT_SETUP([macro maximum nesting level (MNEST)])
+AT_KEYWORDS([MNEST])
+AT_DATA([define.sps], [dnl
+DEFINE !macro()
+!macro
+!ENDDEFINE.
+!macro.
+])
+AT_CHECK([pspp -O format=csv define.sps], [1], [dnl
+"define.sps:1-3: In the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:1-3: inside the expansion of `!macro',
+define.sps:4: error: DEFINE: Maximum nesting level 50 exceeded.  (Use SET MNEST to change the limit.)"
+
+define.sps:4.1-4.6: error: Syntax error at `!macro' (in expansion of `!macro'): expecting command name.
+])
+AT_CLEANUP
+
+AT_SETUP([macro !IF condition])
+AT_KEYWORDS([if])
+for operators in \
+    '!eq !ne !lt !gt !le !ge' \
+    '  =  <>   <   >  <=  >='
+do
+    set $operators
+    AS_BOX([$operators])
+    cat > define.sps <<EOF
+DEFINE !test(!positional !tokens(1))
+!if (!1 $1 1) !then true !else false !ifend
+!if (!1 $2 1) !then true !else false !ifend
+!if (!1 $3 1) !then true !else false !ifend
+!if (!1 $4 1) !then true !else false !ifend
+!if (!1 $5 1) !then true !else false !ifend
+!if (!1 $6 1) !then true !else false !ifend.
+!ENDDEFINE.
+DEBUG EXPAND.
+!test 0
+!test 1
+!test 2
+!test '1'
+!test 1.0
+EOF
+    AT_CAPTURE_FILE([define.sps])
+    AT_CHECK([pspp --testing-mode define.sps], [0], [dnl
+false true true false true false.
+
+true false false false true true.
+
+false true false true false true.
+
+true false false false true true.
+
+false true false true false true.
+])
+done
+AT_CLEANUP
+
+AT_SETUP([macro !IF condition -- case sensitivity])
+AT_KEYWORDS([if])
+for operators in \
+    '!eq !ne !lt !gt !le !ge' \
+    '  =  <>   <   >  <=  >='
+do
+    set $operators
+    AS_BOX([$operators])
+    cat > define.sps <<EOF
+DEFINE !test(!positional !tokens(1))
+!if (!1 $1 a) !then true !else false !ifend
+!if (!1 $1 A) !then true !else false !ifend
+!if (!1 $2 a) !then true !else false !ifend
+!if (!1 $2 A) !then true !else false !ifend
+!if (!1 $3 a) !then true !else false !ifend
+!if (!1 $3 A) !then true !else false !ifend
+!if (!1 $4 a) !then true !else false !ifend
+!if (!1 $4 A) !then true !else false !ifend
+!if (!1 $5 a) !then true !else false !ifend
+!if (!1 $5 A) !then true !else false !ifend
+!if (!1 $6 a) !then true !else false !ifend
+!if (!1 $6 A) !then true !else false !ifend
+!if (!1 $1 !null) !then true !else false !ifend
+!if (!1 $2 !null) !then true !else false !ifend.
+!ENDDEFINE.
+DEBUG EXPAND.
+!test a
+!test A
+!test b
+!test B
+EOF
+    AT_CAPTURE_FILE([define.sps])
+    AT_CHECK([pspp --testing-mode define.sps], [0], [dnl
+true false false true false false false true true false true true false true.
+
+false true true false true false false false true true false true false true.
+
+false false true true false false true true false false true true false true.
+
+false false true true true false false true true false false true false true.
+])
+done
+AT_CLEANUP
+
+AT_SETUP([macro !IF condition -- logical operators])
+AT_KEYWORDS([if])
+for operators in \
+    '!and !or !not' \
+    '   &   |    ~'
+do
+    set $operators
+    AS_BOX([$operators])
+    cat > define.sps <<EOF
+DEFINE !test_binary(!positional !tokens(1)/!positional !tokens(1))
+!if !1 $1 !2 !then true !else false !ifend
+!if !1 $2 !2 !then true !else false !ifend.
+!ENDDEFINE.
+
+DEFINE !test_unary(!positional !tokens(1))
+!if $3 !1 !then true !else false !ifend.
+!ENDDEFINE.
+
+* These are:
+  ((not A) and B) or C
+  not (A and B) or C
+  not A and (B or C)
+DEFINE !test_prec(!pos !tokens(1)/!pos !tokens(1)/!pos !tokens(1))
+!if $3 !1 $1 !2 $2 !3 !then true !else false !ifend
+!if $3 (!1 $1 !2) $2 !3 !then true !else false !ifend
+!if $3 !1 $1 (!2 $2 !3) !then true !else false !ifend
+!ENDDEFINE.
+
+DEBUG EXPAND.
+!test_binary 0 0
+!test_binary 0 1
+!test_binary 1 0
+!test_binary 1 1
+!test_unary 0
+!test_unary 1
+!test_prec 0 0 0 !test_prec 0 0 1 !test_prec 0 1 0 !test_prec 0 1 1.
+!test_prec 1 0 0 !test_prec 1 0 1 !test_prec 1 1 0 !test_prec 1 1 1.
+EOF
+    AT_CAPTURE_FILE([define.sps])
+    AT_CHECK([pspp --testing-mode define.sps], [0], [dnl
+false false.
+
+false true.
+
+false true.
+
+true true.
+
+true.
+
+false.
+
+false true false
+true true true
+true true true
+true true true
+
+false true false
+true true false
+false false false
+true true false
+])
+done
+AT_CLEANUP
+
+AT_SETUP([macro !LET])
+AT_KEYWORDS([let])
+AT_DATA([define.sps], [dnl
+DEFINE !macro(!POS !CMDEND)
+!LET !v1 = !CONCAT('x',!1,'y')
+!LET !v2 = !QUOTE(!v1)
+!LET !v3 = (!LENGTH(!1) = 1)
+!LET !v4 = (!SUBSTR(!1, 3) = !NULL)
+v1=!v1.
+v2=!v2.
+v3=!v3.
+v4=!v4.
+!ENDDEFINE.
+DEBUG EXPAND.
+!macro 0.
+!macro.
+!macro xyzzy.
+])
+AT_CHECK([pspp --testing-mode define.sps], [0], [dnl
+v1 = x0y.
+v2 = x0y.
+v3 = 1.
+v4 = 1.
+
+v1 = xy.
+v2 = xy.
+v3 = 0.
+v4 = 1.
+
+v1 = xxyzzyy.
+v2 = xxyzzyy.
+v3 = 0.
+v4 = 0.
+])
+AT_CLEANUP
+
+AT_SETUP([macro indexed !DO])
+AT_KEYWORDS([index do])
+AT_DATA([define.sps], [dnl
+DEFINE !title(!POS !TOKENS(1)) !1. !ENDDEFINE.
+
+DEFINE !for(!POS !TOKENS(1) / !POS !TOKENS(1))
+!DO !var = !1 !TO !2 !var !DOEND.
+!ENDDEFINE.
+
+DEFINE !forby(!POS !TOKENS(1) / !POS !TOKENS(1) / !POS !TOKENS(1))
+!DO !var = !1 !TO !2 !BY !3 !var !DOEND.
+!ENDDEFINE.
+
+DEBUG EXPAND.
+!title "increasing".
+!for 1 5.
+!forby 1 5 1.
+!forby 1 5 2.
+!forby 1 5 2.5.
+!forby 1 5 -1.
+
+!title "decreasing".
+!for 5 1.
+!forby 5 1 1.
+!forby 5 1 -1.
+!forby 5 1 -2.
+!forby 5 1 -3.
+
+!title "non-integer".
+!for 1.5 3.5.
+])
+AT_CHECK([pspp --testing-mode define.sps], [0], [dnl
+"increasing".
+
+1 2 3 4 5.
+
+1 2 3 4 5.
+
+1 3 5.
+
+1 3.5.
+
+.
+
+"decreasing".
+
+.
+
+.
+
+5 4 3 2 1.
+
+5 3 1.
+
+5 2.
+
+"non-integer".
+
+1.5 2.5 3.5.
+])
+AT_CLEANUP
+
+AT_SETUP([macro !DO invalid variable names])
+AT_KEYWORDS([index do])
+AT_DATA([define.sps], [dnl
+DEFINE !for(x=!TOKENS(1) / y=!TOKENS(1))
+!DO !x = !x !TO !y !var !DOEND.
+!ENDDEFINE.
+
+DEFINE !for2(x=!TOKENS(1) / y=!TOKENS(1))
+!DO !noexpand = !x !TO !y !var !DOEND.
+!ENDDEFINE.
+
+DEBUG EXPAND.
+!for x=1 y=5.
+!for2 x=1 y=5.
+])
+AT_CHECK([pspp --testing-mode define.sps], [1], [dnl
+define.sps:1-3: At `!x' in the expansion of `!for',
+define.sps:10: error: DEBUG EXPAND: Cannot use argument name or macro keyword
+as !DO variable.
+
+!DO 1 = 1 !TO 5 !var !DOEND.
+
+define.sps:5-7: At `!noexpand' in the expansion of `!for2',
+define.sps:11: error: DEBUG EXPAND: Cannot use argument name or macro keyword
+as !DO variable.
+
+!DO !noexpand = 1 !TO 5 !var !DOEND.
+])
+AT_CLEANUP
+
+AT_SETUP([macro indexed !DO reaches MITERATE])
+AT_KEYWORDS([index do])
+AT_DATA([define.sps], [dnl
+DEFINE !title(!POS !TOKENS(1)) !1. !ENDDEFINE.
+
+DEFINE !for(!POS !TOKENS(1) / !POS !TOKENS(1))
+!DO !var = !1 !TO !2 !var !DOEND.
+!ENDDEFINE.
+
+DEFINE !forby(!POS !TOKENS(1) / !POS !TOKENS(1) / !POS !TOKENS(1))
+!DO !var = !1 !TO !2 !BY !3 !var !DOEND.
+!ENDDEFINE.
+
+SET MITERATE=3.
+DEBUG EXPAND.
+!title "increasing".
+!for 1 5.
+!forby 1 5 1.
+!forby 1 5 2.
+!forby 1 5 2.5.
+!forby 1 5 -1.
+
+!title "decreasing".
+!for 5 1.
+!forby 5 1 1.
+!forby 5 1 -1.
+!forby 5 1 -2.
+!forby 5 1 -3.
+
+!title "non-integer".
+!for 1.5 3.5.
+])
+AT_CHECK([pspp --testing-mode define.sps], [1], [dnl
+"increasing".
+
+In the expansion of `!DO',
+define.sps:3-5: inside the expansion of `!for',
+define.sps:14: error: DEBUG EXPAND: Numerical !DO loop exceeded maximum number
+of iterations 3.  (Use SET MITERATE to change the limit.)
+
+1 2 3 4.
+
+In the expansion of `!DO',
+define.sps:7-9: inside the expansion of `!forby',
+define.sps:15: error: DEBUG EXPAND: Numerical !DO loop exceeded maximum number
+of iterations 3.  (Use SET MITERATE to change the limit.)
+
+1 2 3 4.
+
+1 3 5.
+
+1 3.5.
+
+.
+
+"decreasing".
+
+.
+
+.
+
+In the expansion of `!DO',
+define.sps:7-9: inside the expansion of `!forby',
+define.sps:23: error: DEBUG EXPAND: Numerical !DO loop exceeded maximum number
+of iterations 3.  (Use SET MITERATE to change the limit.)
+
+5 4 3 2.
+
+5 3 1.
+
+5 2.
+
+"non-integer".
+
+1.5 2.5 3.5.
+])
+AT_CLEANUP
+
+AT_SETUP([!BREAK with macro indexed !DO])
+AT_KEYWORDS([index do break])
+AT_DATA([define.sps], [dnl
+DEFINE !title(!POS !TOKENS(1)) !1. !ENDDEFINE.
+
+DEFINE !for(!POS !TOKENS(1) / !POS !TOKENS(1) / !POS !TOKENS(1))
+!DO !var = !1 !TO !2
+  !var
+  !IF 1 !THEN
+    !IF !var = !3 !THEN
+      x
+      !BREAK
+      y
+    !IFEND
+    ,
+  !IFEND
+!DOEND.
+!ENDDEFINE.
+
+DEBUG EXPAND.
+!for 1 5 4.
+])
+AT_CHECK([pspp --testing-mode define.sps], [0], [dnl
+1, 2, 3, 4 x.
+])
+AT_CLEANUP
+
+AT_SETUP([macro list !DO])
+AT_KEYWORDS([index do])
+AT_DATA([define.sps], [dnl
+DEFINE !for(!POS !CMDEND)
+(!DO !i !IN (!1) (!i) !DOEND).
+!ENDDEFINE.
+
+DEBUG EXPAND.
+!for a b c.
+!for 'foo bar baz quux'.
+!for.
+])
+AT_CHECK([pspp --testing-mode define.sps], [0], [dnl
+( (a) (b) (c) ).
+
+( (foo) (bar) (baz) (quux) ).
+
+( ).
+])
+AT_CLEANUP
+
+AT_SETUP([macro list !DO reaches MITERATE])
+AT_KEYWORDS([index do])
+AT_DATA([define.sps], [dnl
+DEFINE !for(!POS !CMDEND)
+(!DO !i !IN (!1) (!i) !DOEND).
+!ENDDEFINE.
+
+SET MITERATE=2.
+DEBUG EXPAND.
+!for a b c.
+!for 'foo bar baz quux'.
+!for.
+])
+AT_CHECK([pspp --testing-mode define.sps], [1], [dnl
+In the expansion of `!DO',
+define.sps:1-3: inside the expansion of `!for',
+define.sps:7: error: DEBUG EXPAND: !DO loop over list exceeded maximum number
+of iterations 2.  (Use SET MITERATE to change the limit.)
+
+( (a) (b) ).
+
+In the expansion of `!DO',
+define.sps:1-3: inside the expansion of `!for',
+define.sps:8: error: DEBUG EXPAND: !DO loop over list exceeded maximum number
+of iterations 2.  (Use SET MITERATE to change the limit.)
+
+( (foo) (bar) ).
+
+( ).
+])
+AT_CLEANUP
+
+AT_SETUP([!BREAK with macro list !DO])
+AT_KEYWORDS([index break do])
+AT_DATA([define.sps], [dnl
+DEFINE !for(!POS !TOKENS(1) / !POS !CMDEND)
+(!DO !i !IN (!2)
+  (!i)
+  !IF 1 !THEN
+    !IF !i = !1 !THEN
+      x
+      !BREAK
+      y
+    !IFEND
+    ,
+  !IFEND
+!DOEND).
+!ENDDEFINE.
+
+DEBUG EXPAND.
+!for d a b c.
+!for baz 'foo bar baz quux'.
+!for e.
+])
+AT_CHECK([pspp --testing-mode define.sps], [0], [dnl
+( (a), (b), (c), ).
+
+( (foo), (bar), (baz)x).
+
+( ).
+])
+AT_CLEANUP
+
+AT_SETUP([macro !LET])
+AT_DATA([define.sps], [dnl
+DEFINE !macro(!pos !enclose('(',')'))
+!LET !x=!1
+!LET !y=!QUOTE(!1)
+!LET !z=(!y="abc")
+!y !z
+!ENDDEFINE.
+
+DEBUG EXPAND.
+!macro(1+2).
+!macro(abc).
+])
+AT_CHECK([pspp --testing-mode define.sps -O format=csv], [0], [dnl
+1 + 2 0
+
+abc 1
+])
+AT_CLEANUP
+
+AT_SETUP([macro !LET invalid variable names])
+AT_DATA([define.sps], [dnl
+DEFINE !macro(x=!tokens(1))
+!LET !x=!x
+!ENDDEFINE.
+
+DEFINE !macro2()
+!LET !do=x
+!ENDDEFINE.
+
+DEBUG EXPAND.
+!macro x=1.
+!macro2.
+])
+AT_CHECK([pspp --testing-mode define.sps -O format=csv], [1], [dnl
+"define.sps:1-3: At `!x' in the expansion of `!macro',
+define.sps:10: error: DEBUG EXPAND: Cannot use argument name or macro keyword ""!x"" as !LET variable."
+
+!LET 1 = 1
+
+"define.sps:5-7: At `!do' in the expansion of `!macro2',
+define.sps:11: error: DEBUG EXPAND: Cannot use argument name or macro keyword ""!do"" as !LET variable."
+
+"define.sps:5-7: At `=' in the expansion of `!macro2',
+define.sps:11: error: DEBUG EXPAND: Expected macro variable name following !DO."
+
+!LET !do = x
+])
+AT_CLEANUP
+
+AT_SETUP([BEGIN DATA inside a macro])
+AT_DATA([define.sps], [dnl
+DEFINE !macro()
+DATA LIST NOTABLE /x 1.
+BEGIN DATA
+1
+2
+3
+END DATA.
+LIST.
+!ENDDEFINE.
+
+!macro
+])
+AT_CHECK([pspp define.sps -O format=csv], [0], [dnl
+Table: Data List
+x
+1
+2
+3
+])
+AT_CLEANUP
+
+AT_SETUP([TITLE and SUBTITLE with macros])
+AT_KEYWORDS([macro])
+for command in TITLE SUBTITLE; do
+    cat >title.sps <<EOF
+DEFINE !paste(!POS !TOKENS(1) / !POS !TOKENS(1))
+!CONCAT(!1,!2)
+!ENDDEFINE.
+$command prefix !paste foo bar suffix.
+SHOW $command.
+EOF
+    cat >expout <<EOF
+title.sps:5: note: SHOW: $command is prefix foobar suffix.
+EOF
+    AT_CHECK([pspp -O format=csv title.sps], [0], [expout])
+done
+AT_CLEANUP
+
+AT_SETUP([error message within macro expansion])
+AT_DATA([define.sps], [dnl
+DEFINE !vars(!POS !TOKENS(1)) a b C !ENDDEFINE.
+DATA LIST NOTABLE /a b 1-2.
+COMPUTE x = !vars x.
+])
+AT_CHECK([pspp -O format=csv define.sps], [1], [dnl
+define.sps:3.13-3.19: error: COMPUTE: Syntax error at `b' (in expansion of `!vars x'): expecting end of command.
+])
+AT_CLEANUP
+
+dnl A macro with keyword arguments needs a token of lookahead
+dnl to find out whether another keyword is present.  Test that
+dnl this special case works OK.
+AT_SETUP([macro calls in each others' lookahead])
+AT_DATA([define.sps], [dnl
+DEFINE !k(x=!DEFAULT(0) !TOKENS(1)/y=!DEFAULT(0) !TOKENS(1))
+(x=!x)(y=!y)
+!ENDDEFINE.
+DEBUG EXPAND.
+!k
+!k x=1
+!k y=2
+!k y=2 x=1
+!k x=1 y=2.
+])
+AT_CHECK([pspp -O format=csv define.sps --testing-mode], [0], [dnl
+(x = 0) (y = 0)
+
+(x = 1) (y = 0)
+
+(x = 0) (y = 2)
+(x = 1) (y = 2)
+
+(x = 1) (y = 2)
+])
+AT_CLEANUP
+
+AT_SETUP([bad token in macro body])
+AT_DATA([define.sps], [dnl
+DEFINE !x()
+x'123'
+!ENDDEFINE.
+])
+AT_CHECK([pspp define.sps], [1], [dnl
+define.sps:3: error: DEFINE: String of hex digits has 3 characters, which is
+not a multiple of 2.
+])
+AT_CLEANUP
+
+AT_SETUP([generic macro function syntax errors])
+AT_DATA([define.sps], [dnl
+DEFINE !a() !SUBSTR !ENDDEFINE.
+DEFINE !b() !SUBSTR x !ENDDEFINE.
+DEFINE !c() !SUBSTR(1x) !ENDDEFINE.
+DEFINE !d() !SUBSTR(1 !ENDDEFINE.
+DEFINE !narg_blanks() !BLANKS() !ENDDEFINE.
+DEFINE !narg_concat() !CONCAT() !ENDDEFINE.
+DEFINE !narg_eval() !EVAL() !ENDDEFINE.
+DEFINE !narg_head() !HEAD() !ENDDEFINE.
+DEFINE !narg_index() !INDEX() !ENDDEFINE.
+DEFINE !narg_length() !LENGTH() !ENDDEFINE.
+DEFINE !narg_null() !NULL() !ENDDEFINE.
+DEFINE !narg_quote() !QUOTE() !ENDDEFINE.
+DEFINE !narg_substr() !SUBSTR() !ENDDEFINE.
+DEFINE !narg_tail() !TAIL() !ENDDEFINE.
+DEFINE !narg_unquote() !UNQUOTE() !ENDDEFINE.
+DEFINE !narg_upcase() !UPCASE() !ENDDEFINE.
+dnl )
+DEBUG EXPAND.
+!a.
+!b.
+!c.
+!d.
+!narg_blanks.
+!narg_concat.
+!narg_eval.
+!narg_head.
+!narg_index.
+!narg_length.
+!narg_null.
+!narg_quote.
+!narg_substr.
+!narg_tail.
+!narg_unquote.
+!narg_upcase.
+])
+AT_CHECK([pspp --testing-mode define.sps], [1], [dnl
+define.sps:1: In the expansion of `!a',
+define.sps:18: error: DEBUG EXPAND: `@{:@' expected following !SUBSTR.
+
+!SUBSTR
+
+define.sps:2: At `x' in the expansion of `!b',
+define.sps:19: error: DEBUG EXPAND: `@{:@' expected following !SUBSTR.
+
+!SUBSTR x
+
+define.sps:3: At `x' in the expansion of `!c',
+define.sps:20: error: DEBUG EXPAND: `,' or `@:}@' expected in call to macro
+function !SUBSTR.
+
+!SUBSTR(1 x)
+
+define.sps:4: In the expansion of `!d',
+define.sps:21: error: DEBUG EXPAND: Missing `@:}@' in call to macro function !
+SUBSTR.
+
+!SUBSTR@{:@1
+
+define.sps:5: In the expansion of `!narg_blanks',
+define.sps:22: error: DEBUG EXPAND: Macro function !BLANKS takes one argument
+(not 0).
+
+!BLANKS( )
+
+define.sps:6: In the expansion of `!narg_concat',
+define.sps:23: error: DEBUG EXPAND: Macro function !CONCAT needs at least one
+argument.
+
+!CONCAT( )
+
+define.sps:7: In the expansion of `!narg_eval',
+define.sps:24: error: DEBUG EXPAND: Macro function !EVAL takes one argument
+(not 0).
+
+!EVAL( )
+
+define.sps:8: In the expansion of `!narg_head',
+define.sps:25: error: DEBUG EXPAND: Macro function !HEAD takes one argument
+(not 0).
+
+!HEAD( )
+
+define.sps:9: In the expansion of `!narg_index',
+define.sps:26: error: DEBUG EXPAND: Macro function !INDEX takes two arguments
+(not 0).
+
+!INDEX( )
+
+define.sps:10: In the expansion of `!narg_length',
+define.sps:27: error: DEBUG EXPAND: Macro function !LENGTH takes one argument
+(not 0).
+
+!LENGTH( )
+
+( )
+
+define.sps:12: In the expansion of `!narg_quote',
+define.sps:29: error: DEBUG EXPAND: Macro function !QUOTE takes one argument
+(not 0).
+
+!QUOTE( )
+
+define.sps:13: In the expansion of `!narg_substr',
+define.sps:30: error: DEBUG EXPAND: Macro function !SUBSTR takes two or three
+arguments (not 0).
+
+!SUBSTR( )
+
+define.sps:14: In the expansion of `!narg_tail',
+define.sps:31: error: DEBUG EXPAND: Macro function !TAIL takes one argument
+(not 0).
+
+!TAIL( )
+
+define.sps:15: In the expansion of `!narg_unquote',
+define.sps:32: error: DEBUG EXPAND: Macro function !UNQUOTE takes one argument
+(not 0).
+
+!UNQUOTE( )
+
+define.sps:16: In the expansion of `!narg_upcase',
+define.sps:33: error: DEBUG EXPAND: Macro function !UPCASE takes one argument
+(not 0).
+
+!UPCASE( )
+])
+AT_CLEANUP
+
+AT_SETUP([specific macro function syntax errors])
+AT_DATA([define.sps], [dnl
+DEFINE !a() !BLANKS(x). !ENDDEFINE.
+DEFINE !b() !SUBSTR(x, y). !ENDDEFINE.
+DEFINE !c() !SUBSTR(x, 1, z). !ENDDEFINE.
+DEBUG EXPAND.
+!a.
+!b.
+!c.
+])
+AT_CHECK([pspp --testing-mode define.sps], [1], [dnl
+define.sps:1: In the expansion of `!a',
+define.sps:5: error: DEBUG EXPAND: Argument to !BLANKS must be non-negative
+integer (not "x").
+
+!BLANKS(x).
+
+define.sps:2: In the expansion of `!b',
+define.sps:6: error: DEBUG EXPAND: Second argument of !SUBSTR must be positive
+integer (not "y").
+
+!SUBSTR(x, y).
+
+define.sps:3: In the expansion of `!c',
+define.sps:7: error: DEBUG EXPAND: Third argument of !SUBSTR must be non-
+negative integer (not "z").
+
+!SUBSTR(x, 1, z).
+])
+AT_CLEANUP
+
+AT_SETUP([macro expression errors])
+AT_DATA([define.sps], [dnl
+DEFINE !a() !LET !x = (1. !ENDDEFINE dnl )
+
+DEFINE !b() !DO !x = x. !ENDDEFINE.
+DEFINE !c() !LET !x = (). !ENDDEFINE.
+DEBUG EXPAND.
+!a.
+!b.
+!c.
+])
+AT_CHECK([pspp --testing-mode define.sps], [1], [dnl
+define.sps:1-2: At `.' in the expansion of `!a',
+define.sps:5: error: DEBUG EXPAND: Expecting ')' in macro expression.
+
+!LET !x = (1.
+
+At `x' in the expansion of `!DO',
+define.sps:2: inside the expansion of `!b',
+define.sps:6: error: DEBUG EXPAND: Macro expression must evaluate to a number
+(not "x").
+
+!DO !x = x.
+
+define.sps:3: At `)' in the expansion of `!c',
+define.sps:7: error: DEBUG EXPAND: Expecting literal or function invocation in
+macro expression.
+
+!LET !x = ( ).
+])
+AT_CLEANUP
+
+AT_SETUP([macro !IF errors])
+AT_KEYWORDS([IF])
+AT_DATA([define.sps], [dnl
+DEFINE !a() !IF 1 !ENDDEFINE.
+DEFINE !b() !IF 1 !THEN !ENDDEFINE.
+DEFINE !c() !IF 1 !THEN !ELSE !ENDDEFINE.
+DEBUG EXPAND.
+!a.
+!b.
+!c.
+])
+AT_CHECK([pspp --testing-mode define.sps], [1], [dnl
+define.sps:1: In the expansion of `!a',
+define.sps:5: error: DEBUG EXPAND: !THEN expected in macro !IF construct.
+
+!IF 1
+
+define.sps:2: In the expansion of `!b',
+define.sps:6: error: DEBUG EXPAND: !ELSE or !IFEND expected in macro !IF
+construct.
+
+!IF 1 !THEN
+
+define.sps:3: In the expansion of `!c',
+define.sps:7: error: DEBUG EXPAND: !IFEND expected in macro !IF construct.
+
+!IF 1 !THEN !ELSE
+])
+AT_CLEANUP
+
+AT_SETUP([macro !LET errors])
+AT_KEYWORDS([LET])
+AT_DATA([define.sps], [dnl
+DEFINE !a() !LET !ENDDEFINE.
+DEFINE !b() !LET 0 !ENDDEFINE.
+DEFINE !c() !LET !x !ENDDEFINE.
+DEFINE !d() !LET !x y !ENDDEFINE.
+DEBUG EXPAND.
+!a.
+!b.
+!c.
+!d.
+])
+AT_CHECK([pspp --testing-mode define.sps], [1], [dnl
+define.sps:1: In the expansion of `!a',
+define.sps:6: error: DEBUG EXPAND: Expected macro variable name following !LET.
+
+!LET
+
+define.sps:2: At `0' in the expansion of `!b',
+define.sps:7: error: DEBUG EXPAND: Expected macro variable name following !LET.
+
+!LET 0
+
+define.sps:3: In the expansion of `!c',
+define.sps:8: error: DEBUG EXPAND: Expected `=' following !LET.
+
+!LET !x
+
+define.sps:4: At `y' in the expansion of `!d',
+define.sps:9: error: DEBUG EXPAND: Expected `=' following !LET.
+
+!LET !x y
+])
+AT_CLEANUP
+
+AT_SETUP([macro !DO errors])
+AT_KEYWORDS([DO])
+AT_DATA([define.sps], [dnl
+DEFINE !a() !DO !ENDDEFINE.
+DEFINE !b() !DO 0 !ENDDEFINE.
+DEFINE !c() !DO !x !ENDDEFINE.
+DEFINE !d() !DO !x !in (x) !ENDDEFINE.
+DEFINE !e() !DO !x = x. !ENDDEFINE.
+DEFINE !f() !DO !x = 5 x !ENDDEFINE.
+DEFINE !g() !DO !x = 5 !TO 6 !BY 0 !ENDDEFINE.
+DEFINE !h() !DO !x !ENDDEFINE.
+DEFINE !i() !DO !x 0 !ENDDEFINE.
+DEFINE !j() !BREAK !ENDDEFINE.
+DEBUG EXPAND.
+!a.
+!b.
+!c.
+!d.
+!e.
+!f.
+!g.
+!h.
+!i.
+!j.
+])
+AT_CHECK([pspp --testing-mode define.sps], [1], [dnl
+define.sps:1: In the expansion of `!a',
+define.sps:12: error: DEBUG EXPAND: Expected macro variable name following !DO.
+
+!DO
+
+define.sps:2: At `0' in the expansion of `!b',
+define.sps:13: error: DEBUG EXPAND: Expected macro variable name following !DO.
+
+!DO 0
+
+define.sps:3: In the expansion of `!c',
+define.sps:14: error: DEBUG EXPAND: Expected `=' or !IN in !DO loop.
+
+!DO !x
+
+In the expansion of `!DO',
+define.sps:4: inside the expansion of `!d',
+define.sps:15: error: DEBUG EXPAND: Missing !DOEND.
+
+!DO !x !in(x)
+
+At `x' in the expansion of `!DO',
+define.sps:5: inside the expansion of `!e',
+define.sps:16: error: DEBUG EXPAND: Macro expression must evaluate to a number
+(not "x").
+
+!DO !x = x.
+
+At `x' in the expansion of `!DO',
+define.sps:6: inside the expansion of `!f',
+define.sps:17: error: DEBUG EXPAND: Expected !TO in numerical !DO loop.
+
+!DO !x = 5 x
+
+In the expansion of `!DO',
+define.sps:7: inside the expansion of `!g',
+define.sps:18: error: DEBUG EXPAND: !BY value cannot be zero.
+
+!DO !x = 5 !TO 6 !BY 0
+
+define.sps:8: In the expansion of `!h',
+define.sps:19: error: DEBUG EXPAND: Expected `=' or !IN in !DO loop.
+
+!DO !x
+
+define.sps:9: At `0' in the expansion of `!i',
+define.sps:20: error: DEBUG EXPAND: Expected `=' or !IN in !DO loop.
+
+!DO !x 0
+
+define.sps:10: At `!BREAK' in the expansion of `!j',
+define.sps:21: error: DEBUG EXPAND: !BREAK outside !DO.
+
+])
+AT_CLEANUP
+
+AT_SETUP([macros in comments])
+AT_KEYWORDS([macro])
+AT_DATA([define.sps], [dnl
+DEFINE !macro() x y z !ENDDEFINE.
+/* !macro.
+*!macro.
+DEBUG EXPAND.
+!macro.
+])
+AT_CHECK([pspp --testing-mode define.sps], [0], [dnl
+x y z
+])
+AT_CLEANUP
+
+AT_SETUP([DEFINE syntax errors])
+AT_KEYWORDS([macro])
+AT_DATA([define.sps], [dnl
+DEFINE !macro(!POSITIONAL !CHAREND('x y')) !ENDDEFINE.
+DEFINE !macro(a=!TOKENS(1)/!POSITIONAL !TOKENS(1)) !ENDDEFINE.
+DEFINE !macro(!a=!TOKENS(1)) !ENDDEFINE.
+DEFINE !macro(do=!TOKENS(1)) !ENDDEFINE.
+DEFINE 0() !ENDDEFINE.
+DEFINE x y () !ENDDEFINE.
+DEFINE !macro(1) !ENDDEFINE.
+DEFINE !macro(x 2) !ENDDEFINE.
+DEFINE !macro(x=!DEFAULT 3) !ENDDEFINE.
+DEFINE !macro(x=!TOKENS 4) !ENDDEFINE.
+DEFINE !macro(x=!TOKENS(x)) !ENDDEFINE.
+DEFINE !macro(x=!TOKENS(1 5)) !ENDDEFINE.
+DEFINE !macro(x=!ENCLOSE 6) !ENDDEFINE.
+DEFINE !macro(x=!ENCLOSE('x' y)) !ENDDEFINE.
+DEFINE !macro(x=!ENCLOSE('x',y)) !ENDDEFINE.
+DEFINE !macro(x=!ENCLOSE('x','y' z)) !ENDDEFINE.
+DEFINE !macro(x=!CHAREND 7) !ENDDEFINE.
+DEFINE !macro(x=!CHAREND(8)) !ENDDEFINE.
+DEFINE !macro(x=!CHAREND('x' 9)) !ENDDEFINE.
+DEFINE !macro(x=!WTF) !ENDDEFINE.
+DEFINE !macro(x=!TOKENS(1) x) !ENDDEFINE.
+DEFINE !macro()
+])
+AT_CHECK([pspp define.sps], [1], [dnl
+define.sps:1.36-1.40: error: DEFINE: Syntax error at `'x y'': String must
+contain exactly one token.
+
+define.sps:2.40-2.46: error: DEFINE: Syntax error at `!TOKENS': Positional
+parameters must precede keyword parameters.
+
+define.sps:3.15-3.16: error: DEFINE: Syntax error at `!a': Keyword macro
+parameter must be named in definition without "!" prefix.
+
+define.sps:4.15-4.16: error: DEFINE: Syntax error at `do': Cannot use macro
+keyword "do" as an argument name.
+
+define.sps:5.8: error: DEFINE: Syntax error at `0': expecting identifier.
+
+define.sps:6.10: error: DEFINE: Syntax error at `y': expecting `@{:@'.
+
+define.sps:7.15: error: DEFINE: Syntax error at `1': expecting identifier.
+
+define.sps:8.17: error: DEFINE: Syntax error at `2': expecting `='.
+
+define.sps:9.26: error: DEFINE: Syntax error at `3': expecting `@{:@'.
+
+define.sps:10.25: error: DEFINE: Syntax error at `4': expecting `('.
+
+define.sps:11.25: error: DEFINE: Syntax error at `x': Expected positive integer
+for !TOKENS.
+
+define.sps:12.27: error: DEFINE: Syntax error at `5': expecting `)'.
+
+define.sps:13.26: error: DEFINE: Syntax error at `6': expecting `('.
+
+define.sps:14.30: error: DEFINE: Syntax error at `y': expecting `,'.
+
+define.sps:15.30: error: DEFINE: Syntax error at `y': expecting string.
+
+define.sps:16.34: error: DEFINE: Syntax error at `z': expecting `)'.
+
+define.sps:17.26: error: DEFINE: Syntax error at `7': expecting `('.
+
+define.sps:18.26: error: DEFINE: Syntax error at `8': expecting string.
+
+define.sps:19.30: error: DEFINE: Syntax error at `9': expecting `)'.
+
+define.sps:20.17-20.20: error: DEFINE: Syntax error at `!WTF': expecting !
+TOKENS, !CHAREND, !ENCLOSE, or !CMDEND.
+
+define.sps:21.28: error: DEFINE: Syntax error at `x': expecting `/'.
+
+define.sps:23.1: error: DEFINE: Syntax error at end of command: Expecting macro
+body or !ENDDEFINE.
+])
+AT_CLEANUP
\ No newline at end of file
index c572e5fd864ad8ac042aaf0c983f3b3bd425e066..212aadeb0897037656e0b0e4ca1c7016947a8c35 100644 (file)
@@ -87,7 +87,7 @@ lexer.sps:1: error: Unknown command `datA dist'.
 
 lexer.sps:2: error: LIST: LIST is allowed only after the active dataset has been defined.
 
-lexer.sps:2.6: error: LIST: Syntax error at `...': Bad character U+0000 in input.
+lexer.sps:2.6: error: LIST: Syntax error: Bad character U+0000 in input.
 ])
 AT_CLEANUP