diff options
Diffstat (limited to 'macros/latex/contrib/lisp-on-tex/lisp-on-tex.sty')
-rw-r--r-- | macros/latex/contrib/lisp-on-tex/lisp-on-tex.sty | 918 |
1 files changed, 918 insertions, 0 deletions
diff --git a/macros/latex/contrib/lisp-on-tex/lisp-on-tex.sty b/macros/latex/contrib/lisp-on-tex/lisp-on-tex.sty new file mode 100644 index 0000000000..7b6b79688c --- /dev/null +++ b/macros/latex/contrib/lisp-on-tex/lisp-on-tex.sty @@ -0,0 +1,918 @@ +%% +%% This is file `lisp-on-tex.sty'. +%% +%% License: Modified BSD - see LICENSE file +%% +\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\@lisp@read@eval@loop@catch@error + \else + \let\@@next\@lisp@read@eval@loop@normal@@ + \fi + \@@next#1{#2}} +\def\@lisp@read@eval@loop@normal@@#1#2{\@lispread\@lisp@read@eval@loop} + +\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{} + + + +% CONS CAR CDR +% 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 +% \@tlabel@xxx -> \@eval@xxx\@apply@xxx\@@apply@xxx +% \@dummy => ; +% \@eval@xxx#1#2#3 : #1 = cont, #2 = env, #3 = reg +%%%%% +\def\@@select@eval#1#2#3{#1} +\def\@@select@apply#1#2#3{#2} +\def\@@select@@apply#1#2#3{#3} + +\def\@type@define@filed#1{\expandafter\@@type@define@filed\expandafter#1} +\def\@@type@define@filed#1#2{\expandafter\@@@type@define@filed + \expandafter#1\expandafter#2} +\def\@@@type@define@filed#1#2#3{\expandafter\@@@@type@define@field + \expandafter#1\expandafter#2\expandafter#3} +\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#4{#1#2#3}} + +\@for\@lisp@on@tex@type:=\@defined@lisp@on@tex\do{% + \expandafter\@type@define@filed% + \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} + + + +% 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{}% + \@lisp@eval@save@envfalse + \expandafter\@eval#1{}#2% + \@temp@write@buffer} + +\newif\if@lisp@eval@save@env +\def\@eval#1#2#3#4{% + \begingroup + % 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\@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} + +\def\@eval@cons#1#2#3{\@@eval@cons#1{#2}#3} +\def\@@eval@cons#1#2#3#4{% + \expandafter\@eval#1{#3}\@temp@i + \expandafter\expandafter\expandafter\ifx + \expandafter\@@eval@get@typelabel\@temp@i\@tlabel@exception + \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 % 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 + \let\@flatten@next\@@flatten@next + \else\ifx#1\@tlabel@nil + \let\@flatten@next\@@flatten@fin + \else + \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 + \@create@bind#2{#3}\@lambda@args % convert arg list into internal form + \expandafter\@create@closure\@lambda@args\@{#6}#4{#5}#7} +\def\@create@closure#1\@#2#3#4#5{\gdef#5{\@tlabel@closure{{#1}{#2}#3{#4}}}} + +\def\@create@bind#1#2#3{% + \ifx#1\@tlabel@symbol + \let\@create@bind@next\@@create@listarg + \else\ifx#1\@tlabel@cons + \let\@create@bind@next\@@create@normalarg + \else\ifx#1\@tlabel@nil + \let\@create@bind@next\@@create@finarg + \fi\fi\fi + \@create@bind@next#2#3} +\def\@@create@listarg#1#2{\expandafter\def\expandafter#2\expandafter{#2:#1}} +\def\@@create@normalarg#1#2#3{% + \expandafter\@@create@bind@symbol#1#3% + \expandafter\@create@bind#2#3} +\def\@@create@bind@symbol\@tlabel@symbol#1#2{\expandafter\def\expandafter#2\expandafter{#2#1}} +\def\@@create@finarg#1{\expandafter\def\expandafter#1\expandafter{#1:\@@unused}} +\def\@@unused{\@@unused} + +\def\@apply@quote#1#2#3\@#4#5{\gdef#5{#2{#3}}} + +% 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\@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@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#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\@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.}}}}} + +%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 + \expandafter\@@eval@get@typelabel#8\@tlabel@exception + \let\@@next\@apply@@let@exception + \else\let\@@next\@apply@@let@normal\fi + \@@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}% + \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{} % #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 + \expandafter\@@eval@get@typelabel#8\@tlabel@exception + \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\@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@if#1#2#3#4#5#6#7\@#8#9{% + \@eval#2{#3}{#8}#9% + \expandafter\expandafter\expandafter\ifx + \expandafter\@@eval@get@typelabel#9\@tlabel@exception + \let\@@next\@apply@if@exception + \else\let\@@next\@apply@if@normal\fi + \@@next{#4}{#5}{#6}{#7}{#8}{#9}} +\def\@apply@if@normal#1#2#3#4#5#6{% + \expandafter\@apply@if@next#6#1{#2}#3{#4}{#5}#6% + \aftergroup\@@tco} +\def\@apply@if@exception#1#2#3#4#5#6{} + +% #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 + \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{% + \let\@@next@pre\@apply@eval@args@pre@default + \ifx#3\relax + \let\@@next\@@next@fin + \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 + \else\let\@@next\@apply@eval@args@normal\fi + \@@next{#1}} +\def\@apply@eval@args@normal#1{% + \expandafter\expandafter\expandafter\def + \expandafter\expandafter\expandafter#1\expandafter\expandafter\expandafter{% + \expandafter\@@save#1}% + \let\@@next\@apply@eval@args} +\def\@apply@eval@args@exception#1{\let\@@next\@apply@eval@args@ignore} + +\def\@@next@fin#1#2{} +\def\@apply@eval@args@ignore#1#2#3\relax#4{} + +\def\@apply@get@args@head@typelabel#1#2\relax{#1} + +\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{}}% + \else + \let\@@test@temp@i\@temp@i + \fi + \expandafter\expandafter\expandafter\ifx + \expandafter\@apply@get@args@head@typelabel\@@test@temp@i\relax\@tlabel@exception + \let\@@next\@apply@func@exception + \else + \let\@@next\@apply@func@normal + \fi + \@@next{#1}{#3}{#4}} +\def\@apply@func@normal#1#2#3{% + \expandafter\@apply@func@next\expandafter{\@temp@i}{#1}{#2}#3} +\def\@apply@func@next#1#2#3#4{\@@apply@func{#2}#1\@{#3}#4} +\def\@apply@func@exception#1#2#3{% + \expandafter\gdef\expandafter#3\expandafter{\@temp@i}} + +\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{}}% + \else + \let\@@test@temp@i\@temp@i + \fi + \expandafter\expandafter\expandafter\ifx + \expandafter\@apply@get@args@head@typelabel\@@test@temp@i\relax\@tlabel@exception + \let\@@next\@apply@func@exception + \else + \let\@@next\@apply@envfunc@normal + \fi + \@@next{#1}{#3}{#4}} +\def\@apply@envfunc@normal#1#2#3{% + \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{% + \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{}}% + \else + \let\@@test@temp@i\@temp@i + \fi + \expandafter\expandafter\expandafter\ifx + \expandafter\@apply@get@args@head@typelabel\@@test@temp@i\relax\@tlabel@exception + \let\@@next\@apply@func@exception + \else + \let\@@next\@apply@closure@normal + \fi + \@@next{#1}{#3}{#4}} +\def\@apply@closure@normal#1#2#3{% + \expandafter\@apply@closure@next\expandafter{\@temp@i}{#1}{#2}#3} +\def\@apply@closure@next#1#2#3#4{\@@apply@closure{#2}#1\@{#3}#4} + +\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 + \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} + +% 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@bind@fin + \else + \let\@@next\@@apply@create@env@bind@rest + \fi + \else + \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 + \let\@@next\@@apply@create@env@bind@rest@create@cell + \else + \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 + \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 + \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 + \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} +\def\@eval@if@macro@#1#2#3#4{% + \expandafter\@eval#1{#3}\@temp@i + \expandafter\@eval@if@macro@@\@temp@i#1#2{#3}#4} +\def\@eval@if@macro@@#1#2#3#4#5#6{% + \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{% + \@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 + \expandafter\@@eval@get@typelabel#1\@tlabel@exception + \let\@@next\@apply@begin@exception + \else + \let\@@next\@apply@begin@normal + \fi + \@@next{#1}{#2}{#5}{#6}} +\def\@apply@begin@normal#1#2#3#4{% + \@apply@begin@next#1{#2}#3{#4}} +\def\@apply@begin@exception#1#2#3#4{} + +\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 + \let\@@next\@apply@callocc@exception + \else + \let\@@next\@apply@callocc@normal + \fi + \@@next{#1}{#2}{#3}{#4}{#5}} +\def\@apply@callocc@exception#1#2#3#4#5{} +\def\@apply@callocc@normal#1#2#3#4#5{% + \toks0\expandafter{#5}% + \edef\@@next{\noexpand\begingroup + \noexpand\expandafter\noexpand\@@select@apply\the\toks0 + \noexpand\@tlabel@continuation{\the\c@lisp@continuation@label}}% + \@@next\@{#4}#5\endgroup + \expandafter\@apply@callocc@check#5#5} +\def\@apply@callocc@check#1#2#3{% + \ifx#1\@tlabel@exception + \let\@@next\@apply@callocc@check@contlabel + \else + \let\@@next\@apply@callocc@gobble + \fi + \@@next#2\@#3} +\def\@apply@callocc@gobble#1\@#2{} +\def\@apply@callocc@check@contlabel#1#2\@#3{% + \ifnum#1=\c@lisp@continuation@label + \let\@@next\@apply@callocc@hook + \else + \let\@@next\@apply@callocc@gobble@after@check + \fi + \@@next#3{#2}} +\def\@apply@callocc@gobble@after@check#1#2{} +\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 + \let\@@next\@apply@continuation@exception + \else + \let\@@next\@apply@continuation@normal + \fi + \@@next{#1}{#2}{#3}{#4}{#5}} +\def\@apply@continuation@normal#1#2#3#4#5{% + \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 +\RequirePackage{lisp-read} + +%arithmetical functions +\RequirePackage{lisp-arith} + +%string manipulation +\RequirePackage{lisp-string} + +% connection to TeX world +\RequirePackage{lisp-latexutil} + +% other primitive functions +\RequirePackage{lisp-prim} + +% functions defined by LISP codes +\RequirePackage{lisp-util} |