!<BLF/lowercase_user>
!<BLF/uppercase_key>
MODULE prs3 (								!

%IF %BLISS (BLISS32)
%THEN
		ADDRESSING_MODE (EXTERNAL = LONG_RELATIVE, 		!
		NONEXTERNAL = LONG_RELATIVE) ,
%FI

		IDENT = '6.3-6'
		) =
BEGIN

!++
! Facility: BLISS Formatter
!
! Abstract:
!
!	This module formats BLISS expressions, of which there
!	are two varieties: control expressions and operator
!	expressions.  'prs$expression' is the main entry point
!	to this module.  'prs$oper' formats operator expressions.
!
! Environment: transportable, with Xport
!
!
! REVISION HISTORY
!
!	15-Sep-81	TT	Permit attribute on routine formal parameters
!
!	 4-Nov-81	TT	Remove special case code in PRS$PAREN_ELIST
!				that involved routine formals list. This is now
!				handled by DO_ROUTINE_FORMALS in PARSE2.
!
! END OF REVISION HISTORY
!--

!<BLF/page>
!
! Table of contents:
!--

FORWARD ROUTINE
    do_case : NOVALUE,
    do_codecom : NOVALUE,
    do_count_loop : NOVALUE,
    do_exit : NOVALUE,
    do_if : NOVALUE,
    do_post_loop : NOVALUE,
    do_pre_loop : NOVALUE,
    do_primary : NOVALUE,
    do_select : NOVALUE,
    do_set : NOVALUE,
    prs$expression : NOVALUE,
    prs$oper : NOVALUE,
    prs$paren_elist : NOVALUE;

!
! Include files:
!--

REQUIRE 'BLFCSW';							! Defines control switches 'sw_...'

REQUIRE 'BLFMAC';						! Defines macros 'lex', 'msg', 'write'

REQUIRE 'SYMCOD';						! Defines symbol property table, 'sym...'

REQUIRE 'TOKTYP';					! Defines 'token' and the token type values 's_...'

REQUIRE 'UTLCOD';							! Defines error codes, i.e. 'er_...'

!
! Macros:
!--

!
! Equated symbols:
!--

LITERAL
    true = 1 EQL 1,
    false = 1 NEQ 1;

!
! Own storage:
!--

!
! External references:
!--

EXTERNAL ROUTINE
    ctl$switch,
    lex$getsym : NOVALUE,
    out$break : NOVALUE,
    out$cut,
    out$default : NOVALUE,
    out$erase : NOVALUE,
    out$force : NOVALUE,
    out$indent : NOVALUE,
    out$mark : NOVALUE,
    out$ntbreak : NOVALUE,
    out$pend_skip : NOVALUE,
    out$pop_marks : NOVALUE,
    out$push_marks : NOVALUE,
    out$skip : NOVALUE,
    out$space : NOVALUE,
    out$stoks : NOVALUE,
    out$tok : NOVALUE,
    do_attr_list: novalue,
    prs$block : NOVALUE,						! Parse1
    prs$plit_body : NOVALUE,						! Parse1
    scn$plit : NOVALUE,
    utl$error : NOVALUE;

EXTERNAL
    tok,
    token : tok_block,
    nolabl,						! True if labelled blocks not allowed
    symprop : sym_table;

ROUTINE do_case (block_context) : NOVALUE = 				!

!++
! Functional description:
!
!	This routine formats a CASE expression
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    out$tok ();								! " CASE "
    out$space (1);
    lex;
    prs$expression (.block_context);

    IF .tok EQL s_from
    THEN
	BEGIN
	out$stoks ();							! " FROM "
	lex;
	prs$expression (.block_context);

	IF .tok EQL s_to
	THEN
	    BEGIN
	    out$stoks ();						! " TO "
	    lex;
	    prs$expression (.block_context);				! Limit expression

	    IF .tok EQL s_of
	    THEN
		(out$stoks (); out$force (); lex; )			! "OF"
	    ELSE
		utl$error (er_of);

	    IF .tok EQL s_set
	    THEN
		BEGIN
		out$indent (1);
		do_set (.block_context);
		END
	    ELSE
		utl$error (er_set);					!"SET..TES" missing.

	    IF .tok EQL s_tes
	    THEN
		BEGIN
		out$break ();
		out$tok ();						! Output the "TES"
		out$indent (-1);
		lex;
		END
	    ELSE
		utl$error (er_tes);

	    END;

	END
    ELSE
	utl$error (er_from);

    END;								! End of routine 'do_case'
ROUTINE do_codecom (block_context) : NOVALUE = 				!

!++
! Functional description:
!
!	This routine formats a CODECOMMENT
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    out$break ();
    out$tok ();								! "CODECOMMENT"
    lex;

    WHILE .tok NEQ s_end_of_file DO
	BEGIN

	IF .tok EQL s_string
	THEN
	    BEGIN
	    out$break ();
	    out$tok ();							! String specified
	    lex;
	    END
	ELSE
	    utl$error (er_string);

	IF .tok EQL s_comma
	THEN
	    BEGIN
	    out$erase ();
	    out$tok ();							! ","
	    lex;
	    END
	ELSE
	    BEGIN

	    IF .tok EQL s_colon
	    THEN
		BEGIN
		out$stoks ();						! " : "
		lex;
		END
	    ELSE
		utl$error (er_colon);

	    EXITLOOP;
	    END;

	END;

    IF .tok EQL s_begin OR .tok EQL s_lparen THEN prs$block () ELSE utl$error (er_block_start);

    END;								! End of routine 'do_codecomment'
ROUTINE do_count_loop (block_context) : NOVALUE = 			!

!++
! Functional description:
!
!	This routine formats INCR and DECR loops
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    out$tok ();								! " INCR " or " DECR "
    out$space (1);
    lex;
    out$indent (1);							! Prepare for following lines

    IF .tok EQL s_name
    THEN
	BEGIN
	out$tok ();							! Name of index variable
	lex;
	END
    ELSE
	utl$error (er_name);

    WHILE .tok EQL s_from						!
	OR .tok EQL s_to						!
	OR .tok EQL s_by DO
	BEGIN
	out$stoks ();							! " FROM ", " TO ", or " BY "
	lex;
	prs$expression (.block_context);
	END;

    IF .tok EQL s_do
    THEN
	BEGIN
	out$stoks ();							! " DO " appears on the same line
	(IF .block_context NEQ s_lparen THEN out$force ());
	lex;
	END
    ELSE
	utl$error (er_do);

    out$indent (-1);
    prs$expression (.block_context);					! Parse the action expression.
    END;								! End of routine 'do_count_loop'
ROUTINE do_exit (block_context) : NOVALUE = 				!

!++
! Functional description:
!
!	This routine formats LEAVE, RETURN, and EXITLOOP expressions
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN

    IF .tok EQL s_leave
    THEN
	BEGIN
	out$tok ();							! " LEAVE "
	out$space (1);
	lex;
	out$tok ();							! <label>
	lex;

	IF .tok NEQ s_with THEN RETURN;

	END;

    out$tok ();								! " RETURN " or " EXITLOOP "
    out$space (1);
    lex;
    prs$expression (.block_context);
    END;								! End of routine 'do_exit'
ROUTINE do_if (block_context) : NOVALUE = 				!

!++
! Functional description:
!
!	This routine formats an IF expression
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    out$push_marks ();
    out$tok ();								! " IF "
    out$space (1);
    lex;
    prs$expression (.block_context);				! Parse the control conditional expr.

    IF .tok EQL s_then
    THEN
	BEGIN

	IF .block_context NEQ s_lparen
	THEN

	    IF out$cut ()
	    THEN
		out$break ()						! On a new line put
	    ELSE
		BEGIN
		out$space ();
		out$mark (0);
		out$mark (0);
		END;

	out$stoks ();							! "THEN "

	IF .block_context NEQ s_lparen
	THEN

	    IF out$cut ()
	    THEN
		out$force ()
	    ELSE
		BEGIN
		out$space ();
		out$mark (1);
		END;

	lex;
	prs$expression (.block_context);			! Parse the 'true' action expression.

	IF .tok EQL s_else
	THEN
	    BEGIN

	    IF .block_context NEQ s_lparen
	    THEN

		IF out$cut ()
		THEN
		    out$break ()					! On another new line put
		ELSE
		    BEGIN
		    out$space ();
		    out$mark (0);
		    out$mark (0);
		    END;

	    out$stoks ();						! "ELSE "

	    IF .block_context NEQ s_lparen
	    THEN

		IF out$cut ()
		THEN
		    out$force ()
		ELSE
		    BEGIN
		    out$space ();
		    out$mark (1);
		    END;

	    lex;
	    prs$expression (.block_context);				! Parse the 'false' action expr.
	    END;

	END
    ELSE
	utl$error (er_then);

    out$pop_marks ();
    END;								! End of routine 'do_if'
ROUTINE do_post_loop (block_context) : NOVALUE = 			!

!++
! Functional description:
!
!	This routine formats DO-WHILE and DO-UNTIL expressions
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    out$tok ();								! " DO "
    out$force ();
    lex;
    prs$expression (.block_context);					! Parse the action expression

    IF .tok EQL s_while OR .tok EQL s_until
    THEN
	BEGIN
	out$break ();							! Put the terminating
	out$tok ();							! "UNTIL " or "WHILE " on new line
	out$space (1);
	lex;
	prs$expression (.block_context);				! Conditional for loop
	END
    ELSE
	utl$error (er_post_test);					! "UNTIL" or "WHILE" missing.

    END;								! End of routine 'do_post_loop'
ROUTINE do_pre_loop (block_context) : NOVALUE = 			!

!++
! Functional description:
!
!	This routine formats WHILE and UNTIL expressions
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    out$tok ();								! " UNTIL " or " WHILE "
    out$space (1);
    lex;
    prs$expression (.block_context);					! Conditional value for loop

    IF .tok EQL s_do
    THEN
	BEGIN
	out$stoks ();							! ' DO ' appears on same line

	IF .block_context NEQ s_lparen THEN out$force ();

	lex
	END
    ELSE
	utl$error (er_do);

    prs$expression (.block_context);					! Parse the action expression
    END;								! End of  routine 'do_pre_loop'
ROUTINE do_primary (block_context) : NOVALUE = 				!

!++
! Functional description:
!
!	This routine formats primaries.
!	Since a routine call is a primary, and since a routine
!	address in a routine call is a primary, we continue
!	searching for a "(" after we have found a primary,
!	and continue until there are no more routine calls.
!
!	For the purposes of the formatter, "REP expr OF (list)"
!	is regarded as a primary. This provides for a simple means
!	of handling PLIT bodies and also the argument lists for calls
!	to CH$TRANSTABLE.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN

    !+
    ! Primaries are parsed at the highest precedence level
    !-

    IF .symprop [.tok, sym_close_br] THEN RETURN;

    SELECTONE .tok OF
	SET

	[s_numeric, s_string] :
	    BEGIN
	    out$tok ();							! "Numeric" or "string"
	    lex;
	    END;

	[s_begin, s_lparen] :
	    prs$block ();

	[s_langle, s_lbracket] :

	    !+
	    ! To handle keyword macro refs...
	    !-

	    prs$paren_elist (.block_context);

	[s_plit, s_uplit] :
	    BEGIN
	    out$tok ();							! "PLIT " or "UPLIT "
	    out$space ();

	    IF NOT ctl$switch (sw_plit) THEN scn$plit (+1);		! Suppress formatting of PLIT-bodies

	    lex;
	    prs$plit_body (.block_context);

	    IF NOT ctl$switch (sw_plit) THEN scn$plit (-1);

	    END;

	[s_rep] :
	    BEGIN
	    out$stoks ();
	    lex;
	    prs$expression (.block_context);

	    IF .tok NEQ s_of THEN utl$error (er_of);

	    out$default ();
	    lex;

	    IF .symprop [.tok, sym_type] EQL alloc_unit THEN (out$tok (); lex; );

	    prs$paren_elist (.block_context);
	    END;

	[s_codecomment] :
	    do_codecom (.block_context);

	[s_name] :
	    BEGIN

	    !+
	    ! The following test is heuristic: if the expected colon is one
	    ! space beyond the current name, we can pre-recognize it as a
	    ! label and left-adjust the label on a new line.
	    !-

	    IF CH$RCHAR (CH$PLUS (.token [tok_cp], .token [tok_len])) EQL %C' ' AND 	!
		CH$RCHAR (CH$PLUS (.token [tok_cp], .token [tok_len] + 1)) EQL %C':' AND 	!
		NOT .nolabl
	    THEN
		out$ntbreak ();						! Left- adjust label on new line

	    out$tok ();							! name
	    lex;

	    IF .tok EQL s_string
	    THEN
		(out$tok (); lex; )					! "String"
	    ELSE

		IF .tok EQL s_colon AND NOT .nolabl
		THEN
		    BEGIN
		    out$stoks ();					! " : "
		    out$force ();
		    lex;
		    prs$block ();
		    END;

	    END;



	[OTHERWISE] : 							! Check for allocation-unit
	    BEGIN
!	    IF .symprop [.tok, sym_type] NEQ alloc_unit
!	    THEN
!		utl$error (er_primary);
	    out$default ();						! "BYTE", e.g.
	    lex;
	    END;
	TES;

    WHILE .symprop [.tok, sym_type] EQL open_bracket DO
	prs$paren_elist (.block_context);

    END;								! End of routine 'do_primary'
ROUTINE do_select (block_context) : NOVALUE = 				!

!++
! Functional description:
!
!	This routine formats SELECT, SELECTONE, etc. expressions
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    out$tok ();								! " SELECT... "
    out$space (1);
    lex;
    prs$expression (.block_context);

    IF .tok EQL s_of
    THEN
	BEGIN
	out$stoks ();							! " OF "
	out$force ();
	lex;
	END
    ELSE
	utl$error (er_of);

    IF .tok EQL s_set THEN (out$indent (1); do_set (.block_context); ) ELSE utl$error (er_set);

    IF .tok EQL s_tes
    THEN
	BEGIN
	out$break ();
	out$tok ();							! "TES"
	out$indent (-1);
	lex;
	END
    ELSE
	utl$error (er_tes);

    END;								! End of routine 'do_select'
ROUTINE do_set (block_context) : NOVALUE = 				!

!++
! Functional description:
!
!	This  routine is called to format the SET..TES in
!	CASE and SELECT expressions.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN

    IF .block_context NEQ s_lparen THEN out$break ();			! On a new line put the

    out$stoks ();							! "SET"
    out$force ();
    lex;

    WHILE .tok EQL s_lbracket DO
	BEGIN

	IF .block_context NEQ s_lparen THEN out$skip (1);

	out$tok ();							! "["
	lex;

	WHILE .tok NEQ s_end_of_file DO
	    BEGIN

	    !+
	    ! [ Label ,... ]
	    !-

	    prs$expression (.block_context);

	    IF .tok EQL s_to						! " TO " <expr>
	    THEN
		(out$stoks (); lex; prs$expression (.block_context); );

	    IF .tok EQL s_rbracket
	    THEN
		BEGIN
		out$tok ();						! Closing bracket
		lex;
		EXITLOOP;
		END;

	    IF .tok EQL s_comma
	    THEN
		BEGIN
		out$erase ();
		out$tok ();						! ", "
		out$space (1);
		lex;
		END
	    ELSE

		IF .tok EQL s_tes THEN RETURN ELSE (utl$error (er_set_tes); out$default (); lex; );

	    END;							! [ Label ,... ]

	IF .tok EQL s_colon
	THEN
	    BEGIN
	    out$stoks ();						! " : "

	    IF .block_context NEQ s_lparen THEN out$force ();

	    out$indent (+1);					! Indent block comments at head of block
	    lex;
	    out$indent (-1);
	    END
	ELSE
	    utl$error (er_colon);

	prs$expression (.block_context);				! Action for this value of the set

	IF .tok EQL s_semicolon
	THEN
	    BEGIN
	    out$erase ();
	    out$tok ();							! ";"
	    out$force ();
	    lex;
	    END;

	END;

    END;								! End of routine 'do_set'

GLOBAL ROUTINE prs$expression (block_context) : NOVALUE = 		!

!++
! Functional description:
!
!	This routine formats expressions.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN

    LOCAL
	save_tok;

    out$indent (1);							! Always for every expr.

    IF .tok LSS first_control						!
	OR .tok GTR last_control
    THEN
	prs$oper (1, .block_context)					! Operator expression
    ELSE 								! It's a control expression.
	BEGIN

	!+
	! Dispatch through a transfer vector to format a
	! Control expression .  The format of this vector depends
	! On the ordering of the control symbols in 'TOKTYP.BLI'.
	!-

	BIND
	    ctl_routines = 						!
		UPLIT (
		do_if, 							!
		do_case, 						!
		REP 6 OF (do_select), 					!
		REP 6 OF (do_count_loop), 				!
		REP 2 OF (do_pre_loop), 				!
		do_post_loop, 						!
		REP 3 OF (do_exit))					!
	    : VECTOR [last_control - first_control + 1];

	save_tok = .tok;

	IF .tok LSS s_leave AND 					!
	    .block_context NEQ s_lparen
	THEN
	    out$skip (1);

	! Skip a line for non-trivial control
									! Expressions
	(.ctl_routines [.tok - first_control]) (.block_context);

	!+
	! Skip a line after each non-trivial control expression
	!-

	IF .save_tok LSS s_leave AND 					!
	    .block_context NEQ s_lparen
	THEN
	    out$pend_skip (1);

	END;

    out$indent (-1);
    RETURN;
    END;								! End of routine 'prs$expression'
GLOBAL ROUTINE prs$oper (level, block_context) : NOVALUE = 		!

!++
! Functional description:
!
!	This routine is called to format all operator expressions.
!
!	These are:
!
!	E1 ::= E2 = E1 \ E2
!	E2 ::= E3 EQV E2 \ E3
!		  XOR
!	E3 ::= E4 OR E3 \ E4
!	E4 ::= E5 AND E4 \ E5
!	E5 ::= NOT E5 \ E6
!	E6 ::= E7 <Relational-operators> E7 \ E7
!	E7 ::= E8 + E7 \ E8
!		  -
!	E8 ::= E9 * E8 \ E9
!		  /
!		  MOD
!	E9 ::= E10 ^ E9 \ E10
!	E10 ::= + E11
!		-
!	E11 ::= . E11 \ PRIMARY
!
!	Note that the precedence level of a PRIMARY is 12.
!
! Formal parameters:
!
!	Level - the precedence level this call is to parse at.
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

!<BLF/page>
    BEGIN

    LOCAL
	num_choice;

    MACRO
	plit_count (aplit) =

		((aplit)-%UPVAL)%;

    BIND
	BINARY = UPLIT (0, REP 4 OF (true), false, REP 4 OF (true),
	    false, false) : VECTOR,
	right_prece = 							!
	    UPLIT (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11) : VECTOR,
	left_prece = 							!
	    UPLIT (0, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12) : VECTOR,	! No left precedence for unary ops
	prece_tokens = 							!
	    UPLIT (
	    0, 								! Levels
	    PLIT(s_equal), 						! 1
	    PLIT(s_eqv, s_xor), 					! 2
	    PLIT(s_or), 						! 3
	    PLIT(s_and), 						! 4
	    PLIT(s_not), 						! 5
	    PLIT(							!
	    s_eql, 							! 6
	    s_neq, 							! 6
	    s_lss, 							! 6
	    s_leq, 							! 6
	    s_gtr, 							! 6
	    s_geq, 							! 6
	    s_eqlu, 							! 6
	    s_nequ, 							! 6
	    s_lssu, 							! 6
	    s_lequ, 							! 6
	    s_gtru, 							! 6
	    s_gequ, 							! 6
	    s_eqla, 							! 6
	    s_neqa, 							! 6
	    s_lssa, 							! 6
	    s_leqa, 							! 6
	    s_gtra, 							! 6
	    s_geqa), 							! 6
	    PLIT(s_plus, s_minus), 					! 7
	    PLIT(s_multiply, s_divide, s_mod), 				! 8
	    PLIT(s_circumflex), 					! 9
	    PLIT(s_plus, s_minus), 					! 10
	    PLIT(s_dot))						! 11
	: VECTOR;

    BIND
	choice = .prece_tokens [.level] : VECTOR;

    LITERAL
	primary_level = 12;

!<BLF/page>

    IF .symprop [.tok, sym_close_br] THEN RETURN;

    IF .level EQL primary_level THEN (do_primary (.block_context); RETURN; );

    !+
    ! If binary level, try for left operand. Check operator.
    ! If it matches, try for right operand, and return.
    ! If unary, try to match operator.
    ! If it matches, try for right operand and return.
    ! Otherwise, try for a left operand and return.
    !-

    IF .BINARY [.level] THEN prs$oper (.left_prece [.level], .block_context);

    num_choice = .plit_count (choice);

    INCR i FROM 0 TO .num_choice - 1 DO
	BEGIN

	IF .tok EQL .choice [.i]
	THEN
	    BEGIN

	    IF .tok EQL s_dot OR 					!
		.tok EQL s_multiply OR 					!
		.tok EQL s_divide OR 					!
		.tok EQL s_circumflex OR 				!
		.level EQL 10 AND 					!
		(.tok EQL s_plus OR .tok EQL s_minus)			! Unary +,-
	    THEN
		out$tok ()						! ".", "*", or "/"
	    ELSE
		out$stoks ();						! Binary "+", "-", etc.

	    lex;
	    prs$oper (.right_prece [.level], .block_context);
	    RETURN;
	    END;

	END;

    IF NOT .BINARY [.level] THEN prs$oper (.left_prece [.level], .block_context);

    RETURN;
    END;								! End of routine 'prs$oper'

GLOBAL ROUTINE prs$paren_elist (block_context) : NOVALUE = 		!

!++
! Functional description:
!
!	This routine is invoked to parse a list of expressions,
!	ending with the close bracket corresponding to
!	the symbol contained in 'token', which is
!	assumed to contain the left bracket of the list to
!	be parsed.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN

    LOCAL
	bracket;							! Which kind of bracket opened it

    BIND
	kinds = UPLIT (s_lparen, s_langle, s_lbracket) : VECTOR,
	match = UPLIT (s_rparen, s_rangle, s_rbracket) : VECTOR;

    bracket = .tok;
    out$push_marks ();

    IF .tok NEQ s_langle THEN out$space (1);

    out$tok ();								! Output the left symbol
    lex;

    WHILE .tok NEQ s_end_of_file DO
	BEGIN
	prs$expression (.block_context);

	IF .tok EQL s_comma OR 						!
	    .tok EQL s_semicolon					! In general structure references
	THEN
	    BEGIN
	    out$erase ();
	    out$tok ();							! ", " or "; "
	    out$space (1);
	    out$pop_marks ();
	    out$push_marks ();
	    out$mark (1);						! Prepare to break line here
	    lex;
	    END
	ELSE
	    EXITLOOP;

	END;

								! TT  4-Nov-81
    INCR i FROM 0 TO 2 DO

	IF .kinds [.i] EQL .bracket
	THEN
	    BEGIN

	    IF .tok NEQ .match [.i]
	    THEN
		utl$error (er_inv_bracket)
	    ELSE
		BEGIN
		out$tok ();						! Closing bracket
		out$pop_marks ();
		out$push_marks ();
		lex;
		END;

	    EXITLOOP;
	    END;

    out$pop_marks ();
    END;								! End of routine 'prs$paren_elist'

%TITLE 'Last page of PARSE3.BLI'
END									! End of module 'PARSE3'

ELUDOM