Module decl_macro =
Begin

!+
! routines for declaring macros
!
! syntax:
!
!	decl_macro:	MACRO macro_decl [ ',' macro_decl ]* ';'
!
!	macro_decl:	<identifier> [ '(' args ')' ] [ '[' args ']' ]
!				'=' [ <atom> ]* '%'
!
!	args:		[ <identifier> [ ',' <identifier> ]* ]
!
! notes:
!	there are five variations on macros:
!
!	MACRO foo = 1 %;
!
!		'foo' is a simple macro which takes no arguments.
!
!	MACRO bar(A) = A %;
!
!		'bar' is a macro with a fixed number of arguments.
!
!	MACRO plugh(A)[] = A %;
!
!		'plugh' is a recursive macro which may take a variable
!		number of arguments.  The remaining arguments may be
!		obtained using the %REMAINING macro and the macro
!		may call itself recursively.
!
!	MACRO xyzzy(A)[B] = A,B %;
!
!		'xyzzy' is an iterative macro.  it is called iteratively
!		with the fixed arguments for each iteration and the
!		remaining arguments divided up for each iteration.
!
!	MACRO blech[] = %remaining %;
!
!		'blech' is a pass macro.  the macro is expanded only
!		if it is invoked with one or more arguments.  the
!		arguments may be obtained using the %REMAINING macro.
!-

Require 'bliss.req';

Global Routine decl_macro : Novalue =
Begin
    Local
	s		: Ref ST,
	p		: Ref ST,
	SUBTYPE		: Integer,
	QUIT		: Boolean,
	SAVCOPY		: Integer;

! cannot define a macro within another macro definition or within a structure
! definition.  this is because a common stream structure is used for both
! and that structure is static.

    If .flg_macro_body Or .flg_struct_body Then
	STOP(9);

! loop for each macro to declare

    Do
	Begin

! get the name to declare and declare it as a macro

	Rund(QL_NAME);
	If Not DECLARESYM(s,S_MACRO,TRUE) Then
	    Return;

! place the macro arguments in their own scope

	RaiseScope();

! set the defaults

	s[st_mac_num_fixed] = 0;
	s[st_mac_num_ited]  = 0;
	SUBTYPE = 0;

! check for fixed parameters

	If .DEL Eql TK_CALL Then
	    Begin
	    s[st_mac_num_fixed] = parse_params(S_MACRO_ARG,1,TK_RPAREN);
	    If .s[st_mac_num_fixed] Neq 0 Then
		SUBTYPE<MAC_V_FIXED> = TRUE
	    End;

! check for iterated parameters

	If .DEL Eql TK_LBRACKET Then
	    Begin
	    s[st_mac_num_ited] =
			parse_params(S_MACRO_ARG,.s[st_mac_num_fixed]+1,
					TK_RBRACKET);
	    If .s[st_mac_num_ited] Eql 0 Then
		SUBTYPE<MAC_V_RECURSIVE> = TRUE		! or may be pass
	    Else
		SUBTYPE<MAC_V_ITERATIVE> = TRUE
	    End;

! save the macro type

	s[st_mac_type] = .SUBTYPE;

! check for an '='

	If .DEL Neq TK_EQUAL Then
	    Begin
	    LowerScope();
	    ERROR(.pos_open,.pos_del,0,B11$_MISSING_EQUAL);
	    Return
	    End;

! tell the world we are scanning a macro body

	flg_macro_body = TRUE;
	SCANTYPE = 'M';
	pos_scan = .pos_del;

! loop until an unquoted '$' is reached

	QUIT = FALSE;
	Until .QUIT Do
	    Begin

! get a sym/del pair

	    Rund(QL_MACRO);

! SCANFOR was not allowed to bind macro arguments because it would
! have then tried to expand them.  we therefore do the binding here.

	    If Not .flg_quote_sym And .SYM[gt_type] Eql T_NAME Then
		Begin
		p = .SYM[nt_symb];
		If .p Neqa 0 And .p[st_code] Eql S_MACRO_ARG Then
		    SYM = .p
		End;

! if an unquoted '$', exit or set to exit the loop

	    If Not .flg_quote_del And .DEL Eql '$' Then
		If .SYM Eql NIL Then
		    Exitloop
		Else
		    Begin
		    DEL  = 0;
		    QUIT = TRUE
		    End;

! add sym and del to the macro definition

	    StoreLexeme(prm_buff,SZ_PRM_BUFF,.sym,.del)
	    End;

! save the body

	s[st_mac_body] = stream_quit(prm_buff);

! done with this macro.  release all the arguments declared and
! take us out of macro scan mode.

	LowerScope();
	SCANTYPE = ' ';
	flg_macro_body = FALSE;

! skip over the '$'

	If RundE() Then
	    Return
	End
    While .DEL Eql TK_COMMA
End;

End
Eludom