reduce-historical/psl-1983/kernel/define-smacro.red

%
% 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;