%
% DEFINE-SMACRO.RED - Convert SMacros to Lisp macros
%
% Author: Eric Benson
% Symbolic Computation Group
% Computer Science Dept.
% University of Utah
% Date: 23 October 1981
% Copyright (c) 1981 University of Utah
%
% <PSL.KERNEL>DEFINE-SMACRO.RED.3, 21-Sep-82 10:48:10, Edit by BENSON
% Flagged internal functions
% The functions SafeCDR and StdError are required for run-time support
% of the code generated by DS
CompileTime flag('(InstantiateInForm MakeDS SetMacroReference),
'InternalFunction);
lisp procedure InstantiateInForm(Formals, Form);
if Atom Form then
if Form memq Formals then Form else MkQuote Form
else 'List . for each X in Form collect InstantiateInForm(Formals, X);
lisp procedure SetMacroReference U;
list('SetQ, U, '(car !#Arg));
macro procedure DS Form; %. Define Smacro
%
% DS(FNAME:id, PARAMS:id-list, FN:any):id
% ---------------------------------------
% Type: MACRO
% A convenient syntax for a simple macro definition, known as an SMACRO.
% The syntax of DS is similar to DE, except that a MACRO is defined instead
% of an EXPR, e.g.
% (DS FOO (A B) (BAR A B))
% is equivalent to:
% (DM FOO (U) (LIST 'BAR (CADR U) (CADDR U))).
% The "implicit ProgN" is allowed when using Lisp syntax. DS is invoked
% with Rlisp syntax as the procedure type SMACRO, e.g.
% SMACRO PROCEDURE FOO(A, B); BAR(A, B);
% produces the above Lisp form.
%
MakeDS(cadr Form, caddr Form, cdddr Form);
lisp procedure MakeDS(MacroName, Formals, Form);
begin scalar NewForm, I;
NewForm := list 'PROG;
NewForm := Formals . NewForm;
for each X in Formals do
<< NewForm := '(SetQ !#Arg (SafeCDR !#Arg)) . NewForm;
NewForm := SetMacroReference X . NewForm >>;
NewForm := '(cond ((PairP (cdr !#Arg))
(StdError "Argument mismatch in SMacro expansion")))
. NewForm;
NewForm := list('Return, if null cdr Form then
InstantiateInForm(Formals, car Form)
else 'list . '(quote ProgN)
. for each X in Form collect
InstantiateInForm(Formals, X)) . NewForm;
return 'dm . MacroName . '(!#Arg) . list ReversIP NewForm;
end;
%lisp procedure PutC(Name, Type, Body);
% if Type eq 'SMACRO then Eval MakeDS(Name, cadr Body, cddr Body)
% else
% << put(Name, Type, Body);
% Name >>;
END;