summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/tex/latex/lisp-on-tex/lisp-on-tex.sty
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf-dist/tex/latex/lisp-on-tex/lisp-on-tex.sty')
-rw-r--r--Master/texmf-dist/tex/latex/lisp-on-tex/lisp-on-tex.sty858
1 files changed, 549 insertions, 309 deletions
diff --git a/Master/texmf-dist/tex/latex/lisp-on-tex/lisp-on-tex.sty b/Master/texmf-dist/tex/latex/lisp-on-tex/lisp-on-tex.sty
index 817e8a0a0ae..7b6b79688cf 100644
--- a/Master/texmf-dist/tex/latex/lisp-on-tex/lisp-on-tex.sty
+++ b/Master/texmf-dist/tex/latex/lisp-on-tex/lisp-on-tex.sty
@@ -3,124 +3,160 @@
%%
%% License: Modified BSD - see LICENSE file
%%
-%% input buffer and read function
-
-
-%%===========================================
-%% Macros for Input Programs
-%%===========================================
-
-%%===========================================
-%% Public Field
-%%===========================================
-%% \setinputbuffer : Set the input
-\def\setinputbuffer#1{\gdef\@read@buffer{#1}}
-%% \readchar : Read a letter from the input
-\def\readchar{%
- \ifx\@eof\@read@buffer
- \gdef\@currentread{\@@eof}%
- \else
- \expandafter\@car@buffer\@read@buffer\relax
- \fi}
-%% \unreadchar : Unread a letter from the input
-\def\unreadchar{%
- \ifx\@eof\@currentread\else
- \expandafter\@unreadchar\@currentread
- \gdef\@currentread{}\fi}
-
-%%===========================================
-%% Private Field
-%%===========================================
-\def\@dummy{\@@dummy}
-\def\@read@buffer{} % The input
-\def\@currentread{} % The front letter
-\def\@eof{\@@eof} % EOF
-
-\def\@car@buffer#1#2\relax{\gdef\@currentread{#1}\gdef\@read@buffer{#2}}
-\def\@unreadchar#1{%
- \expandafter\gdef
- \expandafter\@read@buffer
- \expandafter{\expandafter#1\@read@buffer}}
-
-%% assoc \cs -> value
-% constructor
-\def\makeassoc#1{\def#1{}}
-% add member
-\def\addassoc#1#2#3{%#1(assoc),#2(\cs),#3(value)
-\gdef\@temp@add{#3}%
-\expandafter\expandafter\expandafter\gdef\expandafter\expandafter
-\expandafter#1\expandafter\expandafter\expandafter{%
-\expandafter\expandafter\expandafter#2\expandafter\expandafter\expandafter{\expandafter\@temp@add\expandafter}#1}}
-% remove member. It cause error if there is no member
-\def\rmassoc#1#2{% #1(assoc), #2(\cs)
-\def\@rmassoc##1#2##2##3\relax{##1##3}%
-\expandafter\expandafter\expandafter\gdef\expandafter\expandafter\expandafter#1\expandafter\expandafter\expandafter{\expandafter\@rmassoc#1\relax}}
-% exist?
-\def\ifmemassoc#1#2{%
-\expandafter\@ifmemassoc\expandafter#2#1\relax}
-\def\@ifmemassoc#1#2\relax{\ifx\@dummy#2\@dummy\let\@next\@iffalse\else\def\@next{\@@ifmemassoc#1#2\relax}\fi\@next}
-\def\@@ifmemassoc#1#2#3#4\relax{%
-\begingroup\def#1{\@@target}%
-\ifx#1#2\endgroup\let\@next\@iftrue\else\endgroup\def\@next{\@ifmemassoc#1#4\relax}\fi\@next}
-\def\@iffalse{\iffalse}
-\def\@iftrue{\iftrue}
-% get It cause error if there is no member
-\def\getassoc#1#2#3{%
-\def\@getassoc##1#2##2##3\relax{\gdef#3{##2}\relax}\expandafter\@getassoc#1\relax}
-% show
-\def\showassoc#1{\expandafter\@showassoc#1\relax}
-\def\@showassoc#1\relax{\ifx\@dummy#1\@dummy
-\let\@next\relax\else\def\@next{\@@showassoc#1\relax}\fi\@next}
-\def\@@showassoc#1#2#3\relax{\string#1:#2,\ifx\@dummy#3\@dummy\else
-\@showassoc#3\relax\fi}
-
-
-% interface
-\def\@lisp@empty{}
-\def\lispinterp#1{%
- \@lispread\@lisp@read@eval@loop#1\@end@lispread}
+\NeedsTeXFormat{LaTeX2e}
+\ProvidesPackage{lisp-on-tex}[2015/06/22 v2.0]
+
+\RequirePackage{xkeyval}
+\newcount\@lisp@gc@style
+\def\@lisp@opt@gc{}
+% I use bad magic numbers...
+\DeclareOptionX{noGC}{\@lisp@gc@style0\relax}
+\DeclareOptionX{markGC}{\@lisp@gc@style1\relax}
+\DeclareOptionX{GCopt}[]{\def\@lisp@opt@gc{#1}}
+\ExecuteOptionsX{noGC}
+\ProcessOptionsX
+
+
+% lisp's global environment and some macros for it
+\def\@lisp@globalenv{}
+
+% Bind a variable (#1) to a value (#2) on global environment.
+% This macro also define [@lisp@env@#1] to #2.
+\def\@lisp@env@add@global#1#2{%
+ \begingroup
+ \toks0{#1{#2}}%
+ \toks2\expandafter{\@lisp@globalenv}%
+ \xdef\@lisp@globalenv{\the\toks0 \the\toks2}%
+ \endgroup
+ \expandafter\gdef\csname @lisp@env@\string#1\endcsname{#2}}
+% for backword compability...
+\def\addassoc#1#2#3{\@lisp@env@add@global#2{#3}}
+
+
+% Set a control sequence (#1) to the value of a variable (#2)
+% on a local environment (#3) and global environment.
+% If #2 is unbound, it set #1 to an exception object.
+\def\@lisp@env@get@value#1#2#3{%
+ \def\@lisp@env@tmpmacro##1#2##2##3\@lisp@env@tail{%
+ \gdef#1{##2}}%
+ % I use a sentinel \@lisp@env@get@value@dummy.
+ \@lisp@env@tmpmacro#1#3#2{\@lisp@env@get@value@dummy}%
+ \@lisp@env@tail
+ % #2 is not bound on #3, so I try to get the value
+ % from global environment.
+ \def\@@next#1#2{}%
+ \ifx#1\@lisp@env@get@value@dummy
+ \let\@@next\@lisp@env@get@value@global\fi
+ \@@next#1#2%
+ % not found
+ \def\@@next#1#2{}%
+ \ifx#1\relax\let\@@next\@lisp@env@get@value@notfound\fi
+ \@@next#1#2}
+\def\@lisp@env@get@value@dummy{\@lisp@env@get@value@dummy}
+\def\@lisp@env@get@value@global#1#2{%
+ \expandafter\global\expandafter\let\expandafter#1%
+ \csname @lisp@env@\string#2\endcsname}
+\def\@lisp@env@get@value@notfound#1#2{%
+ \gdef#1{\@tlabel@exception{{-1}{\@tlabel@string{unbound variable #2}}}}}
+
+% ENTRY point of LISP on TeX. It takes a LISP program (#1)
+% and evaluate the program.
+\def\lispinterp#1{\@lispread\@lisp@read@eval@loop#1\@end@lispread}
\def\@lisp@read@eval@loop#1#2{%
+ \ifx#1\@tlabel@exception% read error
+ \let\@@next\@lisp@read@eval@loop@reader@error
+ \else
+ \let\@@next\@lisp@read@eval@loop@normal
+ \fi\@@next#1{#2}}
+\def\@lisp@read@eval@loop@normal#1#2{%
+ \def\@lisp@tmp@global@i{#1{#2}}%
+ \lispeval\@lisp@tmp@global@i\@lisp@tmp@global@i
+ \expandafter\@lisp@read@eval@loop@normal@\@lisp@tmp@global@i}
+\def\@lisp@read@eval@loop@normal@#1#2{%
\ifx#1\@tlabel@exception
- \let\@@next\relax
+ \let\@@next\@lisp@read@eval@loop@catch@error
\else
- \def\@reg@tmp{#1{#2}}%
- \def\@@next{%
- \lispeval\@reg@tmp\@reg@tmp
- \@lispread\@lisp@read@eval@loop}%
- \fi\@@next}
-
-
-% eval
-%% write buffer
-\gdef\@temp@write@buffer{}
-\def\@add@to@write@buffer#1#2{%
- \expandafter\gdef\expandafter#1\expandafter{#1#2}}
+ \let\@@next\@lisp@read@eval@loop@normal@@
+ \fi
+ \@@next#1{#2}}
+\def\@lisp@read@eval@loop@normal@@#1#2{\@lispread\@lisp@read@eval@loop}
-%% global environment
-\makeassoc\@globalenv
+\def\@lisp@read@eval@loop@catch@error\@tlabel@exception#1{%
+ \@lisp@read@eval@loop@print@err#1}
+\def\@lisp@read@eval@loop@print@err#1#2{%
+% #1 -> error handler id, #2 -> error message
+ \@lisp@read@eval@loop@print@err@#2}
+\def\@lisp@read@eval@loop@print@err@#1#2{%
+ \toks0{#2}\errmessage{LISP on TeX ERROR: \the\toks0}%
+ \@lisp@read@eval@loop@gobble@remain}
+\def\@lisp@read@eval@loop@gobble@remain#1\@end@lispread{}
+%FIXME: Now, the reader cannot tell consuming all input from imcomplete
+% input.
+\def\@lisp@read@eval@loop@reader@error\@tlabel@exception#1{}
-% implemeted functions
% CONS CAR CDR
-\newcount\@malloc
-\def\@get@car#1\@tlabel@cons#2{\@@get@car#1#2}
-\def\@@get@car#1#2#3{\global\let#1#2}
-\def\@get@cdr#1\@tlabel@cons#2{\@@get@cdr#1#2}
-\def\@@get@cdr#1#2#3{\global\let#1#3}
-\def\@make@cons#1#2#3#4#5{%
- \expandafter\gdef\csname car\the\@malloc\endcsname{#2{#3}}%
- \expandafter\gdef\csname cdr\the\@malloc\endcsname{#4{#5}}%
- \@@make@cons#1\csname car\the\@malloc\endcsname\csname cdr\the\@malloc\endcsname
- \global\advance\@malloc1\relax}
-\def\@@make@cons#1{\expandafter\@@@make@cons\expandafter#1}
-\def\@@@make@cons#1#2{\expandafter\@@@@make@cons\expandafter#1\expandafter#2}
-\def\@@@@make@cons#1#2#3{\gdef#1{\@tlabel@cons{#2#3}}}
-
-
-\def\@defined@datatype{symbol,string,int,bool,dimen,skip,cons,nil,func,closure,macro,envfunc,mutable,exception,continuation}
-\def\@defined@specialform{lambda,quote,define,if,defmacro,begin,mdefine,setb,@let,@mlet,macroexpand,callocc}
+% get CAR of a CONS cell (#2{#3}) and set it to a control sequence
+% (#1). If the argument is not a CONS cell, it raise an exception.
+\def\@lisp@perform@car#1#2#3{%
+ \ifx#2\@tlabel@cons
+ \let\@@next\@lisp@perform@car@normal
+ \else
+ \let\@@next\@lisp@perform@car@type@error
+ \fi
+ \@@next#1{#3}}
+\def\@lisp@perform@car@normal#1#2{\@lisp@perform@car@normal@#1#2}
+\def\@lisp@perform@car@normal@#1#2#3{\global\let#1#2}
+\def\@lisp@perform@car@type@error#1#2{%
+ \gdef#1{\@tlabel@exception{{-1}%
+ {\@tlabel@string{Argument of car must be a CONS cell.}}}}}
+% get CDR of a CONS cell (#2{#3}) and set it to a control sequence
+% (#1). If the argument is not a CONS cell, it raise an exception.
+\def\@lisp@perform@cdr#1#2#3{%
+ \ifx#2\@tlabel@cons
+ \let\@@next\@lisp@perform@cdr@normal
+ \else
+ \let\@@next\@lisp@perform@cdr@type@error
+ \fi
+ \@@next#1{#3}}
+\def\@lisp@perform@cdr@normal#1#2{\@lisp@perform@cdr@normal@#1#2}
+\def\@lisp@perform@cdr@normal@#1#2#3{\global\let#1#3}
+\def\@lisp@perform@cdr@type@error#1#2{%
+ \gdef#1{\@tlabel@exception{{-1}%
+ {\@tlabel@string{Argument of cdr must be a CONS cell.}}}}}
+% create a CONS cell whose CAR is #2{#3} and CDR is #4{#5}.
+% It set a control sequence (#1) to the created cell.
+\def\@lisp@perform@cons#1#2#3#4#5{%
+ \@lisp@perform@cons@local#1#2{#3}#4{#5}%
+ \global\let#1#1}
+\def\@lisp@perform@cons@local#1#2#3#4#5{%
+ \@lisp@gc@save@objects@local{#2{#3}#4{#5}}% pin arguments
+ \@lisp@gc@alloc\@lisp@tmp@local@i
+ \expandafter\@lisp@gc@save@memory@local\expandafter{\@lisp@tmp@local@i}% pin CAR
+ \@lisp@gc@alloc\@lisp@tmp@local@ii
+ \expandafter\gdef\@lisp@tmp@local@i{#2{#3}}%
+ \expandafter\gdef\@lisp@tmp@local@ii{#4{#5}}%
+ \expandafter\@lisp@perform@cons@\expandafter#1%
+ \@lisp@tmp@local@i\@lisp@tmp@local@ii}
+\def\@lisp@perform@cons@#1#2#3{%
+ \expandafter\@lisp@perform@cons@@\expandafter#1%
+ \expandafter#2#3}
+\def\@lisp@perform@cons@@#1#2#3{\def#1{\@tlabel@cons{#2#3}}}
+
+
+% all primitive types of LISP on TeX.
+\def\@defined@datatype{%
+ symbol,string,int,bool,dimen,skip,cons,nil,%
+ func,closure,macro,envfunc,mutable,%
+ exception,continuation}
+% all special forms of LISP on TeX
+\def\@defined@specialform{%
+ lambda,quote,define,if,defmacro,begin,%
+ mdefine,setb,@let,@mlet,macroexpand,callocc}
\edef\@defined@lisp@on@tex{\@defined@datatype,\@defined@specialform}
+% all additional types of LISP on TeX
+\def\@defined@additional@type{}
%%%%%MEMO
@@ -140,73 +176,51 @@
\def\@@@@type@define@field#1#2#3#4{%
\def#1##1##2##3{\gdef##3{#4{##1}}}%
\def#2{\errmessage{LISP on TeX [internal apply]: cannot apply}}%
- \def#3{\errmessage{LISP on teX [function --- apply]: cannot apply}}%
+ \def#3{\errmessage{LISP on TeX [function --- apply]: cannot apply}}%
\def#4{#1#2#3}}
-\@for\@type:=\@defined@lisp@on@tex\do{%
+\@for\@lisp@on@tex@type:=\@defined@lisp@on@tex\do{%
\expandafter\@type@define@filed%
- \csname @eval@\@type\endcsname%
- \csname @apply@\@type\endcsname%
- \csname @@apply@\@type\endcsname%
- \csname @tlabel@\@type\endcsname}
-
+ \csname @eval@\@lisp@on@tex@type\endcsname%
+ \csname @apply@\@lisp@on@tex@type\endcsname%
+ \csname @@apply@\@lisp@on@tex@type\endcsname%
+ \csname @tlabel@\@lisp@on@tex@type\endcsname}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-% memo of fasteval branch
-% Each bound variables \var
-% is defined as TeX macro [[@lisp@env@\var]]
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\def\@lisp@expand@env@last{\@lisp@expand@env@last}
-\def\@lisp@expand@environment#1#2#3\@lisp@expand@env@last{%
- \def\@@tmp@lisp@env{#3}%
- \def\@@tmp{\expandafter\def\csname @lisp@env@\string#1\endcsname{#2}}%
- \ifx\@empty\@@tmp@lisp@env
- \let\@@next\relax
- \else
- \def\@@next{\@lisp@expand@environment#3\@lisp@expand@env@last}%
- \fi
- \expandafter\@@next\@@tmp}
+% write buffer. LISP on TeX's evaluator
+\gdef\@temp@write@buffer{}
+\def\@add@to@write@buffer#1#2{%
+ \expandafter\gdef\expandafter#1\expandafter{#1#2}}
\def\lispeval#1#2{% #1 : \cs -> S-exp, #2 : target register
- \gdef\@temp@write@buffer{}%
- \expandafter\def\expandafter\@@tmp@lisp@env\expandafter{\@globalenv}%
- \ifx\@empty\@globalenv\else
- \expandafter\@lisp@expand@environment\@globalenv\@lisp@expand@env@last\fi
+ \gdef\@temp@write@buffer{}%
+ \@lisp@eval@save@envfalse
\expandafter\@eval#1{}#2%
- \@temp@write@buffer}
+ \@temp@write@buffer}
+\newif\if@lisp@eval@save@env
\def\@eval#1#2#3#4{%
\begingroup
- \def\@@tmp@lisp@env{#3}%
- \ifx\@empty\@@tmp@lisp@env\else
- \@lisp@expand@environment#3\@lisp@expand@env@last\fi
+ % pin target S-exp object.
+ \if@lisp@eval@save@env
+ \@lisp@eval@save@envfalse
+ \expandafter\@lisp@gc@save@env@local
+ \else
+ \expandafter\@gobble
+ \fi{#3}%
+ \@lisp@gc@save@objects@local{#1{#2}}%
\expandafter\@@select@eval#1{#2}{#3}#4%
\endgroup}
-\def\@append@env@global#1#2{%
- \def#2{#1}%
- \expandafter\expandafter\expandafter\def
- \expandafter\expandafter\expandafter#2%
- \expandafter\expandafter\expandafter{\expandafter#2\@globalenv}}
-\def\@eval@symbol#1#2#3{% #1 symbol #2 current env (ignored) #3 dist
- \expandafter\global\expandafter\let\expandafter#3\csname @lisp@env@\string#1\endcsname
- \ifx#3\relax % not found
- \errmessage{LISP on TeX [evaluation of a symbol]: unbound variable...}%
- \else
- \expandafter\@expand@if@mutable#3#3%
- \fi}
-\def\@expand@if@mutable#1#2#3{%
- \let\@@next\@expand@if@mutable@next@f
- \ifx#1\@tlabel@mutable\let\@@next\@expand@if@mutable@next@t\fi
- \@@next{#2}{#3}}
-\def\@expand@if@mutable@next@f#1#2{}
-\def\@expand@if@mutable@next@t#1#2{\global\let#2#1}
+\def\@eval@symbol#1#2#3{% #1 symbol #2 current env #3 dist
+ \@lisp@env@get@value#3#1{#2}%
+ \expandafter\@eval@symbol@expand@mutable#3#3}
+\def\@eval@symbol@expand@mutable#1#2#3{%
+ \ifx#1\@tlabel@mutable\global\let#3#2\fi}
\def\@@eval@get@typelabel#1#2{#1}
-
\def\@eval@envcs#1#2#3#4{\expandafter\@@eval@envcs\expandafter{#1}#2{#3}#4}
\def\@@eval@envcs#1#2#3#4{\@eval#2{#3}{#1}#4}
@@ -218,12 +232,24 @@
\let\@@next\@@eval@cons@exception\else\let\@@next\@@eval@cons@normal\fi
\@@next{#2}{#3}{#4}}
\def\@@eval@cons@normal#1#2#3{%
+ \expandafter\@lisp@gc@save@objects@local\expandafter{\@temp@i}% pin evaluated value of CAR
\def\@temp@ii{}% init
- \expandafter\@flatten@args#1\@temp@ii
- \expandafter\expandafter\expandafter\@@select@apply@pre
- \expandafter\@temp@i\@temp@ii\@{#2}#3}
+ \expandafter\@flatten@args#1\@temp@ii % args are already pined, maybe...
+ %error-check of argument form
+ \ifx\@temp@ii\@@flatten@error@symbol
+ \let\@@next\@@eval@cons@args@error
+ \else
+ \let\@@next\@@eval@cons@apply
+ \fi
+ \@@next{#2}{#3}}
\def\@@select@apply@pre{\expandafter\@@select@apply}
\def\@@eval@cons@exception#1#2#3{\global\let#3\@temp@i}
+\def\@@eval@cons@apply#1#2{%
+ \expandafter\expandafter\expandafter\@@select@apply@pre
+ \expandafter\@temp@i\@temp@ii\@{#1}#2}
+\def\@@eval@cons@args@error#1#2{%
+ \gdef#2{\@tlabel@exception{%
+ {-1}{\@tlabel@string{Eval Improper List}}}}}
\def\@flatten@args#1#2#3{%
\ifx#1\@tlabel@cons
@@ -231,17 +257,17 @@
\else\ifx#1\@tlabel@nil
\let\@flatten@next\@@flatten@fin
\else
- \errmessage{LISP on TeX [internal apply]: Invalid args}%
+ \let\@flatten@next\@@flatten@error
\fi\fi
\@flatten@next#2#3}
-
\def\@@flatten@next#1#2#3{%
\expandafter\expandafter\expandafter\def
\expandafter\expandafter\expandafter#3%
\expandafter\expandafter\expandafter{\expandafter#3#1}%
\expandafter\@flatten@args#2#3}
-
\def\@@flatten@fin#1{}
+\def\@@flatten@error#1#2{\def#2{error}}
+\def\@@flatten@error@symbol{error}
\def\@apply@lambda#1#2#3#4#5\@#6#7{%
\def\@lambda@args{}% init
@@ -268,56 +294,128 @@
\def\@apply@quote#1#2#3\@#4#5{\gdef#5{#2{#3}}}
-\def\@apply@define#1\@tlabel@symbol#2#3#4\@#5#6{%
+% application of define, defineM, defmacro.
+% #1 empty, #2{#3} 1st argument, #4{#5} 2nd argument,
+% #6 env, #7 cs
+\def\@apply@define#1#2#3#4#5\@#6#7{%
+ \let\@lisp@define@normal\@apply@define@normal
+ \@apply@define@{#1}#2{#3}#4{#5}\@{#6}#7}
+\def\@apply@mdefine#1#2#3#4#5\@#6#7{%
+ \let\@lisp@define@normal\@apply@mdefine@normal
+ \@apply@define@{#1}#2{#3}#4{#5}\@{#6}#7}
+\def\@apply@defmacro#1#2#3#4#5\@#6#7{%
+ \let\@lisp@define@normal\@apply@defmacro@normal
+ \@apply@define@{#1}#2{#3}#4{#5}\@{#6}#7}
+% type check
+\def\@apply@define@#1#2#3#4#5\@#6#7{%
+ \ifx#2\@tlabel@symbol % normal style
+ \let\@@next\@apply@define@@
+ \else\ifx#2\@tlabel@cons % function definition
+ \let\@@next\@apply@define@func
+ \else
+ \let\@@next\@apply@define@error
+ \fi\fi
+ \@@next{#1}#2{#3}#4{#5}\@{#6}#7}
+% \define's normal form
+\def\@apply@define@normal#1#2{%
+ \expandafter\@lisp@env@add@global\expandafter#1\expandafter{#2}%
+ \gdef#2{\@tlabel@nil{}}}
+% \defineM's normal form
+\def\@apply@mdefine@normal#1#2{%
+ \@lisp@gc@save@objects@local{#2}% pin the evaluated value
+ \@lisp@gc@alloc\@lisp@tmp@local@i
+ \expandafter\global\expandafter\let\@lisp@tmp@local@i#2%
+ \expandafter\@apply@mdefine@normal@\@lisp@tmp@local@i#1%
+ \gdef#2{\@tlabel@nil{}}}
+\def\@apply@mdefine@normal@#1#2{%
+ \@lisp@env@add@global#2{\@tlabel@mutable{#1}}}
+% \defmacro's normal form
+\def\@apply@defmacro@normal#1#2{%
+ \expandafter\@apply@defmacro@next\expandafter#1#2%
+ \gdef#2{\@tlabel@nil{}}}
+%TODO: error handling
+\def\@apply@defmacro@next#1\@tlabel@closure#2{%
+ \@lisp@env@add@global#1{\@tlabel@macro{#2}}}
+% normal form
+\def\@apply@define@@#1\@tlabel@symbol#2#3#4\@#5#6{%
\@eval#3{#4}{#5}#6% define does NOT use local environment
\expandafter\expandafter\expandafter\ifx
\expandafter\@@eval@get@typelabel#6\@tlabel@exception
\let\@@next\@apply@define@exception
- \else\let\@@next\@apply@define@normal\fi
+ \else\let\@@next\@lisp@define@normal\fi
\@@next{#2}{#6}}
-
+% function form
+\def\@apply@define@func#1\@tlabel@cons#2#3#4\@#5#6{%
+ \@apply@define@func@#2#3{#4}\@{#5}#6}
+\def\@apply@define@func@#1#2#3#4\@#5#6{%
+ \expandafter\expandafter\expandafter\ifx
+ \expandafter\@@eval@get@typelabel#1\@tlabel@symbol
+ \let\@@next\@apply@define@func@@
+ \else
+ \let\@@next\@apply@define@error
+ \fi
+ \@@next#1#2#3{#4}\@{#5}#6}
+\def\@apply@define@func@@#1#2#3#4\@#5#6{% notice: no tmp token remain the closure
+ \def\@lisp@tmp@local@i{#3{#4}}% closure body
+ \def\@lisp@tmp@local@ii{\@tlabel@nil{}}%
+ \def\@lisp@tmp@local@iii{\@tlabel@cons{\@lisp@tmp@local@i\@lisp@tmp@local@ii}}%
+ \expandafter\def\expandafter\@lisp@tmp@local@iv\expandafter{#2}% formal arguments
+ \def\@lisp@tmp@local@v{\@tlabel@cons{\@lisp@tmp@local@iv\@lisp@tmp@local@iii}}%
+ \def\@lisp@tmp@local@vi{\@tlabel@lambda{}}% \lambda
+ \expandafter\@apply@define@@\expandafter{\expandafter}#1\@tlabel@cons{\@lisp@tmp@local@vi\@lisp@tmp@local@v}\@{#5}#6}
+% type error
+\def\@apply@define@error#1\@#2#3{%
+ \gdef#3{\@tlabel@exception{{-1}
+ {\@tlabel@string{The 1st argument of \define or \defineM must be a symbol or valid list.}}}}}
+% catch exception at evaluation
\def\@apply@define@exception#1#2{}
-\def\@apply@define@normal#1#2{%
- \expandafter\addassoc\expandafter\@globalenv\expandafter#1\expandafter{#2}%
- \gdef#2{\@tlabel@nil{}}}
-\def\@apply@mdefine#1\@tlabel@symbol#2#3#4\@#5#6{%
- \@eval#3{#4}{#5}#6% mdefine does NOT use local environment
+\def\@apply@setb#1#2#3#4#5\@#6#7{%
+ \ifx\@tlabel@symbol#2%
+ \let\@@next\@apply@setb@normal
+ \else
+ \let\@@next\@apply@setb@argtype@symbol@error
+ \fi
+ \@@next#3#4{#5}{#6}#7}
+\def\@apply@setb@normal#1#2#3#4#5{%
+ \@lisp@env@get@value#5#1{#4}%
\expandafter\expandafter\expandafter\ifx
- \expandafter\@@eval@get@typelabel#6\@tlabel@exception
- \let\@@next\@apply@define@exception
- \else\let\@@next\@apply@mdefine@normal\fi
- \@@next{#2}{#6}}
-
-\def\@apply@mdefine@normal#1#2{%
- \expandafter\@mutable@allocate#2%
- \expandafter\addassoc
- \expandafter\@globalenv
- \expandafter#1%
- \expandafter{\expandafter\@tlabel@mutable
- \expandafter{\csname mutable\the\@malloc\endcsname}}%
- \global\advance\@malloc1\relax
+ \expandafter\@@eval@get@typelabel#5\@tlabel@exception
+ \let\@@next\@apply@setb@raise@exception
+ \else\expandafter\expandafter\expandafter\ifx
+ \expandafter\@@eval@get@typelabel#5\@tlabel@mutable
+ \let\@@next\@apply@setb@normal@
+ \else
+ \let\@@next\@apply@setb@argtype@mutable@error
+ \fi\fi
+ \@@next#1#2{#3}{#4}#5}
+\def\@apply@setb@normal@#1#2#3#4#5{%
+ % the environment and the value is already pinned, maybe...
+ \let\@lisp@tmp@local@i#5%
+ \@eval#2{#3}{#4}#5%
+ \expandafter\expandafter\expandafter\ifx
+ \expandafter\@@eval@get@typelabel#5\@tlabel@exception
+ \let\@@next\@apply@setb@raise@exception
+ \else
+ \let\@@next\@apply@setb@normal@@
+ \fi
+ \@@next#1#2{#3}{#4}#5}
+\def\@apply@setb@normal@@#1#2#3#4#5{%
+ \expandafter\@apply@setb@final\@lisp@tmp@local@i#5}
+\def\@apply@setb@final\@tlabel@mutable#1#2{%
+ \global\let#1#2%
\gdef#2{\@tlabel@nil{}}}
-\def\@mutable@allocate#1#2{\expandafter\gdef\csname mutable\the\@malloc\endcsname{#1{#2}}}
+\def\@apply@setb@argtype@symbol@error#1#2#3#4#5{%
+ \gdef#5{\@tlabel@exception{{-1}%
+ {\@tlabel@string{The 1st argument of \setB must be a symbol}}}}}
+\def\@apply@setb@raise@exception#1#2#3#4#5{}
+\def\@apply@setb@argtype@mutable@error#1#2#3#4#5{%
+ \gdef#5{\@tlabel@exception{{-1}%
+ {\@tlabel@string{The symbol #1 is not defined as a 'mutable'. %
+ Use \defineM, \letM, or \letrec.}}}}}
-\def\@apply@setb#1\@tlabel@symbol#2#3#4\@#5#6{%
- \@eval#3{#4}{#5}#6%
- \expandafter\expandafter\expandafter\ifx
- \expandafter\@@eval@get@typelabel#6\@tlabel@exception
- \let\@@next\@apply@setb@exception
- \else\let\@@next\@apply@setb@normal\fi
- \@@next{#2}{#5}{#6}}
-\def\@apply@setb@normal#1#2#3{%
- \let\@@save#3%
- \@append@env@global{#2}\@temp@env
- \getassoc\@temp@env#1\@temp@i
- \let#3\@@save%
- \expandafter\@set@mutable\@temp@i#3%
- \gdef#3{\@tlabel@nil{}}}
-\def\@set@mutable\@tlabel@mutable#1#2{\global\let#1#2}
-\def\@apply@setb@exception#1#2#3{}
-
+%TODO: error handling
\def\@apply@@let#1\@tlabel@symbol#2#3#4#5#6\@#7#8{%
\@eval#3{#4}{#7}#8%
\expandafter\expandafter\expandafter\ifx
@@ -327,11 +425,21 @@
\@@next{#2}{#5}{#6}{#7}{#8}}
\def\@apply@@let@normal#1#2#3#4#5{%
\expandafter\def\expandafter\@temp@env\expandafter{\expandafter#1\expandafter{#5}#4}%
- \expandafter\gdef\expandafter\@@tco
- \expandafter{\expandafter\@@eval@envcs\expandafter{\@temp@env}#2{#3}#5}%
+ \begingroup
+ \toks0\expandafter{\@temp@env}%
+ \toks1{#2{#3}#5}%
+ \toks2\expandafter{#5}%
+ \xdef\@@tco{%
+ \begingroup
+ \noexpand\@lisp@eval@save@envtrue
+ \noexpand\@lisp@gc@save@objects@local{\the\toks2}% pin appended value
+ \noexpand\@@eval@envcs{\the\toks0}\the\toks1
+ \endgroup}%
+ \endgroup
\aftergroup\@@tco}
-\def\@apply@@let@exception#1#2#3#4#5{}
+\def\@apply@@let@exception#1#2#3#4#5{} % #5 is already set the value of exception
+%TODO: error handling
\def\@apply@@mlet#1\@tlabel@symbol#2#3#4#5#6\@#7#8{%
\@eval#3{#4}{#7}#8%
\expandafter\expandafter\expandafter\ifx
@@ -339,27 +447,27 @@
\let\@@next\@apply@@let@exception
\else\let\@@next\@apply@@mlet@normal\fi
\@@next{#2}{#5}{#6}{#7}{#8}}
+
\def\@apply@@mlet@normal#1#2#3#4#5{%
- \expandafter\global\expandafter\let\csname mutable\the\@malloc\endcsname#5%
- \expandafter\def\expandafter#5\expandafter{\expandafter\@tlabel@mutable
- \expandafter{\csname mutable\the\@malloc\endcsname}}%
- \global\advance\@malloc1\relax
- \expandafter\def\expandafter\@temp@env\expandafter{\expandafter#1\expandafter{#5}#4}%
- \expandafter\gdef\expandafter\@@tco
- \expandafter{\expandafter\@@eval@envcs\expandafter{\@temp@env}#2{#3}#5}%
+ \expandafter\@lisp@gc@save@objects@local\expandafter{#5}% pin target value
+ \@lisp@gc@alloc\@lisp@tmp@local@i
+ \expandafter\global\expandafter\let\@lisp@tmp@local@i#5%
+ \expandafter\@apply@@mlet@normal@\@lisp@tmp@local@i#1{#4}%
+ \begingroup
+ \toks0\expandafter{\@lisp@tmp@local@ii}%
+ \toks1{#2{#3}#5}%
+ \toks2\expandafter{\@lisp@tmp@local@i}%
+ \xdef\@@tco{%
+ \begingroup
+ \noexpand\@lisp@eval@save@envtrue
+ \noexpand\@lisp@gc@save@memory@local{\the\toks2}% pin the appended value
+ \noexpand\@@eval@envcs{\the\toks0}\the\toks1
+ \endgroup}%
+ \endgroup
\aftergroup\@@tco}
+\def\@apply@@mlet@normal@#1#2#3{%
+ \def\@lisp@tmp@local@ii{#2{\@tlabel@mutable{#1}}#3}}
-\def\@apply@defmacro#1\@tlabel@symbol#2#3#4\@#5#6{%
- \@eval#3{#4}{#5}#6% NOT use local env!
- \expandafter\expandafter\expandafter\ifx
- \expandafter\@@eval@get@typelabel#6\@tlabel@exception
- \let\@@next\@apply@define@exception
- \else\let\@@next\@apply@defmacro@normal\fi
- \@@next{#2}{#6}}
-\def\@apply@defmacro@normal#1#2{%
- \expandafter\@apply@defmacro@next\expandafter#1#2%
- \gdef#2{\@tlabel@nil{}}}
-\def\@apply@defmacro@next#1\@tlabel@closure#2{\addassoc\@globalenv#1{\@tlabel@macro{#2}}}
\def\@apply@if#1#2#3#4#5#6#7\@#8#9{%
\@eval#2{#3}{#8}#9%
@@ -373,18 +481,28 @@
\aftergroup\@@tco}
\def\@apply@if@exception#1#2#3#4#5#6{}
-\def\@apply@if@next\@tlabel@bool#1#2#3#4#5#6#7{%
- \let\@@next\relax
- \ifx#1t%
- \let\@@next\@apply@if@next@t
- \else\ifx#1f%
- \let\@@next\@apply@if@next@f
+% #1{#2} -> condition, #3{#4} -> then, #5{#6} -> else, #7 -> env, #8 ->cs
+\def\@apply@if@next#1#2#3#4#5#6#7#8{%
+ \ifx#1\@tlabel@bool
+ \ifx#2t%
+ \let\@@next\@apply@if@next@t
+ \else\ifx#2f%
+ \let\@@next\@apply@if@next@f
+ \else
+ \let\@@next\@apply@if@next@invalid
+ \fi\fi
\else
- \errmessage{LISP on TeX [if]: Invalid boolean. It's BUG. Please report.}%
- \fi\fi\@@next{#1}{#2}{#3}{#4}{#5}{#6}{#7}}
-\def\@apply@if@next@t#1#2#3#4#5#6#7{\gdef\@@tco{\@eval#2{#3}{#6}#7}}
-\def\@apply@if@next@f#1#2#3#4#5#6#7{\gdef\@@tco{\@eval#4{#5}{#6}#7}}
-
+ \let\@@next\@apply@if@next@type@error
+ \fi
+ \@@next#3{#4}#5{#6}{#7}#8}
+\def\@apply@if@next@t#1#2#3#4#5#6{\gdef\@@tco{\@eval#1{#2}{#5}#6}}
+\def\@apply@if@next@f#1#2#3#4#5#6{\gdef\@@tco{\@eval#3{#4}{#5}#6}}
+\def\@apply@if@next@invalid#1#2#3#4#5#6{%
+ \gdef\@@tco{\gdef#6{\@tlabel@exception{%
+ {-1}{\@tlabel@string{Fatal. Invalid Boolean}}}}}}
+\def\@apply@if@next@type@error#1#2#3#4#5#6{%
+ \gdef\@@tco{\gdef#6{\@tlabel@exception{%
+ {-1}{\@tlabel@string{The condition must be a bool.}}}}}}
%% use general
\def\@apply@eval@args#1#2#3#4{%
@@ -394,11 +512,11 @@
\else
\let\@@next@pre\@apply@eval@args@pre@i
\fi\@@next@pre{#1}{#2}{#3}{#4}\@@next#1{#2}}
-
\def\@apply@eval@args@pre@default#1#2#3#4{}
\def\@apply@eval@args@pre@i#1#2#3#4{%
\let\@@save#1%
\@eval#3{#4}{#2}#1%
+ \expandafter\@lisp@gc@save@objects@local\expandafter{#1}% pin evaluated value
\expandafter\expandafter\expandafter\ifx
\expandafter\@@eval@get@typelabel#1\@tlabel@exception
\let\@@next\@apply@eval@args@exception
@@ -419,6 +537,7 @@
\def\@apply@func#1#2\@#3#4{%
\def\@temp@i{}%
\def\@@dummy@temp@i{}%
+ \@lisp@gc@save@objects@local{\@tlabel@func{#1}}% pin function
\@apply@eval@args\@temp@i{#3}#2\relax\relax
\ifx\@@dummy@temp@i\@temp@i%
\def\@@test@temp@i{\@tlabel@dummy{}}%
@@ -438,11 +557,18 @@
\def\@apply@func@exception#1#2#3{%
\expandafter\gdef\expandafter#3\expandafter{\@temp@i}}
-\def\@@apply@func#1#2\@#3#4{\gdef\@@tco{#1#4#2\relax\relax}\aftergroup\@@tco}
+\def\@@apply@func#1#2\@#3#4{%
+ \gdef\@@tco{%
+ % pin arguments because this stack will be fold.
+ \begingroup
+ \@lisp@gc@save@objects@local{#2}%
+ #1#4#2\relax\relax
+ \endgroup}\aftergroup\@@tco}
\def\@apply@envfunc#1#2\@#3#4{%
\def\@temp@i{}%
\def\@@dummy@temp@i{}%
+ \@lisp@gc@save@objects@local{\@tlabel@envfunc{#1}}% pin function
\@apply@eval@args\@temp@i{#3}#2\relax\relax
\ifx\@temp@i\@@dummy@temp@i%
\def\@@test@temp@i{\@tlabel@dummy{}}%
@@ -460,12 +586,20 @@
\expandafter\@apply@envfunc@next\expandafter{\@temp@i}{#1}{#2}#3}
\def\@apply@envfunc@next#1#2#3#4{\@@apply@envfunc{#2}#1\@{#3}#4}
-\def\@@apply@envfunc#1#2\@#3#4{\gdef\@@tco{#1#4{#3}#2\relax\relax}\aftergroup\@@tco}
+\def\@@apply@envfunc#1#2\@#3#4{%
+ \gdef\@@tco{%
+ \begingroup
+ \@lisp@gc@save@objects@local{#2}%
+ \@lisp@eval@save@envtrue%
+ #1#4{#3}#2\relax\relax
+ \endgroup}\aftergroup\@@tco}
\def\@apply@closure#1#2\@#3#4{%
\def\@temp@i{}%
\def\@@dummy@temp@i{}%
+ \@lisp@gc@save@objects@local{\@tlabel@closure{#1}}% pin closure
+ \@lisp@gc@save@objects@local{#2}% pin arguments
\@apply@eval@args\@temp@i{#3}#2\relax\relax
\ifx\@temp@i\@@dummy@temp@i%
\def\@@test@temp@i{\@tlabel@dummy{}}%
@@ -486,91 +620,149 @@
\def\@@apply@closure#1#2\@#3#4{\@@apply@closure@next#1#2\@#4}
\def\@@apply@closure@next#1#2#3#4#5\@#6{%
\def\@temp@env{}%
+ \@lisp@gc@save@objects@local{#5}% pin arguments
\@@apply@create@env\@temp@env#1#5\relax\relax
- \expandafter\gdef\expandafter\@@tco\expandafter{%
- \expandafter\@@eval@envcs\expandafter{\@temp@env#2}#3{#4}#6}%
+ \begingroup
+ \toks0\expandafter{\@temp@env#2}%
+ \toks1{#3{#4}#6}%
+ \xdef\@@tco{%
+ \noexpand\@lisp@eval@save@envtrue
+ \noexpand\@@eval@envcs{\the\toks0}\the\toks1}%
+ \endgroup
\aftergroup\@@tco}
-\def\@@apply@create@env#1#2:#3#4#5{%
- \let\@@next@pre\@@apply@create@env@pre@default
- \ifx!#2!% if #2 is empty
- \let\@@next@args@\@empty
+% create an environment using in evaluation of closure's body.
+% It set a control sequence (#1) to the created environment locally.
+% #2 is formal arguments and #3 is rest argument. If there is
+% no rest argument, #3 is \@@unused. If an error occurs, it set
+% #1 to \relax by \let.
+\def\@@apply@create@env#1#2:#3{%
+ \def#1{}% initialize
+ \@@apply@create@env@#1{#2}{#3}}
+\def\@@apply@create@env@#1#2#3{%
+ \ifx!#2!% If #2 is empty
\ifx#3\@@unused
- \let\@@next\@@apply@create@env@fin
+ \let\@@next\@@apply@create@env@bind@fin
\else
- \ifx#4\relax
- \let\@@next\@@apply@create@env@fin
- \@@apply@modify@env#1\@tlabel@nil{}#3\@
- \else
- \let\@@next@pre\@@apply@create@env@pre@i
- \fi
+ \let\@@next\@@apply@create@env@bind@rest
\fi
\else
- \let\@@next@pre\@@apply@create@env@pre@ii
- \fi\@@next@pre{#1}{#2}{#3}{#4}{#5}\expandafter\@@next\expandafter#1\@@next@args@:#3}
-
-\def\@@apply@create@env@pre@default#1#2#3#4#5{}
-\def\@@apply@create@env@pre@i#1#2#3#4#5{%
- \@@apply@create@env@phantom
- \expandafter\@@apply@modify@env\expandafter#1\@@@@ph#3\@
- \expandafter\gdef\csname car\the\@malloc\endcsname{#4{#5}}%
- \let\@@next\@@apply@create@env@cdr}
-\def\@@apply@create@env@pre@ii#1#2#3#4#5{%
- \@@apply@modify@env#1#4{#5}#2\@
- \@@next@args#2\@
- \let\@@next\@@apply@create@env}
-
-
-\def\@@apply@create@env@cdr#1:#2{\@@@apply@create@env@cdr}
-\def\@@@apply@create@env@cdr#1#2{%
+ \let\@@next\@@apply@create@env@bind@one
+ \fi
+ \@@next#1#2|{#3}}
+% end of environment creation. If there are some
+% remaining arguments, it cause error.
+\def\@@apply@create@env@bind@fin#1|#2#3#4{%
+ \ifx#3\relax\else
+ \let#1\relax
+ \def\@@apply@create@env@error@message{Too more arguments}%
+ \fi}
+% bind a formal argument. #5{#6} is an real argument
+% of closure/macro call. If there is no unbound argument,
+% #5 and #6 are \relax (see caller).
+\def\@@apply@create@env@bind@one#1#2#3|#4#5#6{%
+ \ifx#5\relax
+ \let\@@next\@@apply@create@env@bind@one@error
+ \else
+ \let\@@next\@@apply@create@env@bind@one@
+ \fi
+ \@@next#1#2{#3}{#4}{#5{#6}}}
+\def\@@apply@create@env@bind@one@#1#2#3#4#5{%
+ \expandafter\def\expandafter#1\expandafter{#1#2{#5}}%
+ \@@apply@create@env@#1{#3}{#4}}
+\def\@@apply@create@env@bind@one@error#1#2#3#4#5{%
+ \def\@@apply@create@env@error@message{Too few arguments}%
+ \let#1\relax}
+% bind a rest argument (#2).
+\def\@@apply@create@env@bind@rest#1|#2{%
+ \def\@lisp@tmp@local@i{#1#2}%
+ \def\@lisp@tmp@local@ii{}%
+ \@@apply@create@env@bind@rest@}
+% get all remaining arguments and create a list.
+% it set the result to \@lisp@tmp@local@iii
+\def\@@apply@create@env@bind@rest@#1#2{%
\ifx#1\relax
- \expandafter\gdef\csname cdr\the\@malloc\endcsname{\@tlabel@nil{}}%
- \global\advance\@malloc1\relax
- \let\@@next\relax
+ \let\@@next\@@apply@create@env@bind@rest@create@cell
\else
- \global\advance\@malloc1\relax
- \@@apply@create@env@phantom
- \global\advance\@malloc-1\relax
- \expandafter\@@set@cdr\@@@@ph
- \global\advance\@malloc1\relax
- \expandafter\gdef\csname car\the\@malloc\endcsname{#1{#2}}%
- \let\@@next\@@@apply@create@env@cdr
- \fi\@@next}
-
-\def\@@set@cdr#1#2{\expandafter\gdef\csname cdr\the\@malloc\endcsname{#1{#2}}}
-\def\@@apply@create@env@phantom{%
- \expandafter\@@@apply@ph\csname car\the\@malloc\endcsname\csname cdr\the\@malloc\endcsname}
-\def\@@@apply@ph#1{\expandafter\@@@@apply@ph\expandafter#1}
-\def\@@@@apply@ph#1#2{\def\@@@@ph{\@tlabel@cons{#1#2}}}
-\def\@@apply@create@env@fin#1:#2{}
-\def\@@apply@modify@env#1#2#3#4#5\@{%
- \ifx#2\relax
- \errmessage{LISP on TeX [apply --- closure]: too few args}%
+ \let\@@next\@@apply@create@env@bind@rest@reverse
+ \fi
+ \@@next#1{#2}}
+% reverse the arguments' order and set it to \@lisp@tmp@local@ii
+\def\@@apply@create@env@bind@rest@reverse#1#2{%
+ \toks0{#1{#2}}%
+ \toks2\expandafter{\@lisp@tmp@local@ii}%
+ \edef\@lisp@tmp@local@ii{\the\toks0 \the\toks2}%
+ \@@apply@create@env@bind@rest@}
+% create a list
+\def\@@apply@create@env@bind@rest@create@cell#1#2{% #1 and #2 is dummy
+ \def\@lisp@tmp@local@iii{\@tlabel@nil{}}%
+ \ifx\@lisp@tmp@local@ii\@empty%if there is no argument
+ \let\@@next\@@apply@create@env@bind@rest@create@cell@fin
+ \else
+ \let\@@next\@@apply@create@env@bind@rest@create@cell@alloc
+ \fi
+ \expandafter\@@next\@lisp@tmp@local@ii\relax\relax}
+\def\@@apply@create@env@bind@rest@create@cell@fin{%
+ \expandafter\@@apply@create@env@bind@rest@create@cell@fin@\@lisp@tmp@local@i}
+\def\@@apply@create@env@bind@rest@create@cell@fin@#1#2{%
+ \expandafter\@@apply@create@env@bind@rest@create@cell@fin@@
+ \expandafter{\@lisp@tmp@local@iii}#1#2}
+\def\@@apply@create@env@bind@rest@create@cell@fin@@#1#2#3{%
+ \expandafter\def\expandafter#2\expandafter{#2#3{#1}}}
+\def\@@apply@create@env@bind@rest@create@cell@alloc#1#2#3#4{%
+ \@lisp@gc@alloc\@lisp@tmp@local@iv % CAR
+ \expandafter\gdef\@lisp@tmp@local@iv{#1{#2}}%
+ \@lisp@gc@alloc\@lisp@tmp@local@v % CDR
+ \expandafter\global\expandafter\let\@lisp@tmp@local@v\@lisp@tmp@local@iii
+ \toks0\expandafter{\@lisp@tmp@local@iv}%
+ \toks2\expandafter{\@lisp@tmp@local@v}%
+ \edef\@lisp@tmp@local@iii{\noexpand\@tlabel@cons{\the\toks0 \the\toks2}}%
+ \ifx#3\relax
+ \let\@@next\@@apply@create@env@bind@rest@create@cell@fin
\else
- \expandafter\def\expandafter#1\expandafter{#1#4{#2{#3}}}%
- \fi}
-\def\@@next@args#1#2\@{\def\@@next@args@{#2}}
+ \let\@@next\@@apply@create@env@bind@rest@create@cell@alloc
+ \fi
+ \@@next#3{#4}}
+% koko, @apply to @@apply wo irekaeru beki?
\def\@@apply@macro#1#2\@#3#4{\@@apply@macro@next#1#2\@{#3}#4}
\def\@@apply@macro@next#1#2#3#4#5\@#6#7{%
\def\@temp@env{}%
+ \@lisp@gc@save@objects@local{#5}% pin arguments
\@@apply@create@env\@temp@env#1#5\relax\relax
- \expandafter\gdef\expandafter\@@tco\expandafter{%
- \expandafter\@@eval@envcs\expandafter{\@temp@env#2}#3{#4}#7%
- \expandafter\@eval#7{#6}#7}%
+ \begingroup
+ \toks0\expandafter{\@temp@env#2}%
+ \toks1{#3{#4}#7}%
+ \toks2{#7{#6}#7}%
+ \xdef\@@tco{%
+ \noexpand\@@eval@envcs{\the\toks0}\the\toks1
+ \noexpand\expandafter\noexpand\@eval\the\toks2}%
+ \endgroup
\aftergroup\@@tco}
\let\@apply@macro\@@apply@macro
\def\@apply@macroexpand#1#2#3\@#4#5{% cont, args, \@ env, reg
\let\@@apply@macro@next\@@apply@macro@next@expand@only
+ \@lisp@eval@save@envtrue
\@eval#2{#3}{#4}#5%
+ \expandafter\@lisp@gc@save@objects@local\expandafter{#5}% pin tmp result
\expandafter\@eval#5{#4}#5}
\def\@@apply@macro@next@expand@only#1#2#3#4#5\@#6#7{%
\def\@temp@env{}%
+ \@lisp@gc@save@objects@local{#5}% pin args
\@@apply@create@env\@temp@env#1#5\relax\relax
- \expandafter\gdef\expandafter\@@tco\expandafter{%
- \expandafter\@@eval@envcs\expandafter{\@temp@env#2}#3{#4}#7%
- \expandafter\@eval@if@macro#7{#6}#7}%
+ \begingroup
+ \toks0\expandafter{\@temp@env#2}%
+ \toks1{#3{#4}#7}%
+ \toks2\expandafter{#7{#6}#7}%
+ \xdef\@@tco{%
+ \begingroup
+ \noexpand\@lisp@eval@save@envtrue
+ \noexpand\@@eval@envcs{\the\toks0}\the\toks1
+ \noexpand\@lisp@eval@save@envtrue
+ \noexpand\@eval@if@macro\the\toks2
+ \endgroup}%
+ \endgroup
\aftergroup\@@tco}
\def\@eval@if@macro#1#2#3#4{%
\ifx#1\@tlabel@cons\@eval@if@macro@#2{#3}#4\fi}
@@ -581,17 +773,20 @@
\ifx#1\@tlabel@macro\@eval\@tlabel@cons{#3#4}{#5}#6\else\gdef#6{\@tlabel@cons{#3#4}}\fi}
-
\def\@apply@begin#1#2\@#3#4{%
\@apply@begin@next#4{#3}#2\relax\relax}
\def\@apply@begin@next#1#2#3#4#5#6{%
+ \@lisp@gc@save@env@local{#2}% pin environment
\ifx#5\relax
\let\@@next\@apply@begin@final
\else
\let\@@next\@apply@begin@cont
\fi\@@next{#1}{#2}{#3}{#4}{#5}{#6}}
\def\@apply@begin@final#1#2#3#4#5#6{%
- \gdef\@@tco{\@eval#3{#4}{#2}#1}\aftergroup\@@tco}
+ \gdef\@@tco{%
+ \@lisp@eval@save@envtrue
+ \@eval#3{#4}{#2}#1}%
+ \aftergroup\@@tco}
\def\@apply@begin@cont#1#2#3#4#5#6{%
\@eval#3{#4}{#2}#1%
\expandafter\expandafter\expandafter\ifx
@@ -608,6 +803,7 @@
\newcount\c@lisp@continuation@label
\def\@apply@callocc#1#2#3\@#4#5{%
\advance\c@lisp@continuation@label 1
+ \@lisp@gc@save@env@local{#4}%
\@eval#2{#3}{#4}#5%
\expandafter\expandafter\expandafter\ifx
\expandafter\@@eval@get@typelabel#5\@tlabel@exception
@@ -643,6 +839,7 @@
\def\@apply@callocc@hook#1#2{\gdef#1{#2}}
\def\@apply@continuation#1#2#3\@#4#5{%
+ \@lisp@gc@save@env@local{#4}%
\@eval#2{#3}{#4}#5%
\expandafter\expandafter\expandafter\ifx
\expandafter\@@eval@get@typelabel#5\@tlabel@exception
@@ -655,24 +852,67 @@
\toks0\expandafter{#5}%
\xdef#5{\noexpand\@tlabel@exception{{#1}{\the\toks0}}}}
+% check #function's arguments
+%#1 #args(*, +, or n), #2 function body
+%#3 reg, #4 args
+\newcount\@lisp@func@heck@args@count
+\def\@lisp@func@check@args#1#2#3#4\relax{%
+ \@lisp@func@heck@args@count0
+ \@lisp@func@check@args@#4\relax\relax
+ \def\@@next@true{#2#3#4\relax}%
+ \def\@@next@few{\gdef#3{%
+ \@tlabel@exception{{-1}%
+ {\@tlabel@string{too few arguments}}}}}%
+ \def\@@next@many{\gdef#3{%
+ \@tlabel@exception{{-1}%
+ {\@tlabel@string{too many arguments}}}}}%
+ \ifx#1*%
+ \let\@@next\@@next@true
+ \else\ifx#1+%
+ \ifnum\@lisp@func@heck@args@count>0
+ \let\@@next\@@next@true
+ \else
+ \let\@@next\@@next@few
+ \fi
+ \else
+ \ifnum\@lisp@func@heck@args@count=#1
+ \let\@@next\@@next@true
+ \else\ifnum\@lisp@func@heck@args@count>#1
+ \let\@@next\@@next@many
+ \else
+ \let\@@next\@@next@few
+ \fi\fi
+ \fi\fi
+ \@@next}
+\def\@lisp@func@check@args@#1#2{%
+ \ifx#1\relax
+ \let\@@next\relax
+ \else
+ \advance\@lisp@func@heck@args@count1
+ \let\@@next\@lisp@func@check@args@
+ \fi
+ \@@next}
+
+% select GC engine
+\ifcase\@lisp@gc@style
+ \expandafter\RequirePackage\expandafter[\@lisp@opt@gc]{lisp-simple-alloc} \or
+ \expandafter\RequirePackage\expandafter[\@lisp@opt@gc]{lisp-gc} \fi
+\@lisp@gc@init
% reader
-\input{lisp-read.sty}
+\RequirePackage{lisp-read}
%arithmetical functions
-\input{lisp-arith.sty}
+\RequirePackage{lisp-arith}
%string manipulation
-\input{lisp-string.sty}
+\RequirePackage{lisp-string}
% connection to TeX world
-\input{lisp-latexutil.sty}
-
-% type cast functions
-\input{lisp-cast.sty}
+\RequirePackage{lisp-latexutil}
% other primitive functions
-\input{lisp-prim.sty}
+\RequirePackage{lisp-prim}
% functions defined by LISP codes
-\input{lisp-util.sty}
+\RequirePackage{lisp-util}