;;; -*- mode:lisp;package:user;base:10.;fonts:(cptfontb) -*- 
;;;  $Header: /ct/interp/adas70.l,v 1.17 84/12/26 16:41:59 penny Exp $
;;;  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                            adas70.l                              ;;;
;;; Paul Robertson                                  January 30, 1983 ;;;
;;;                                                                  ;;;
;;;      The C*T Ada Interpreters Syntax and Static Semantics        ;;;
;;;                                                                  ;;;
;;; This file is part of a proprietary software project.  Source     ;;;
;;; code and documentation describing implementation details are     ;;;
;;; available on a confidential, non-disclosure basis only.  These   ;;;
;;; materials, including this file in particular, are trade secrets  ;;;
;;; of Computer * Thought Corporation.                               ;;;
;;;                                                                  ;;;
;;; (c) Copyright 1982 and 1983,  Computer * Thought Corporation.    ;;;
;;;     All Rights Reserved.                                         ;;;
;;;                                                                  ;;;
;;; Reference materials:                                             ;;;
;;;   Miller, 1982.  The C*T Ada Tutor: Guide to the Implementation. ;;;
;;;   Charniak et al., 198?.  Artificial Intelligence Programming.   ;;;
;;;                                                                  ;;;
;;; The following code assumes familiarity with the above.           ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Ensure presence of needed files. 

(eval-when (compile load eval) (ct_load 'aip))	      ;AIP macros pkg. 

(eval-when (compile load eval) (ct_load 'compat))     ;Franz/LM compat pkg. 

(eval-when (compile load eval) (ct_load 'time))       ;Timing functions. 

(eval-when (compile load eval) (ct_load 'stdenv))     ; contains vital macro

(eval-when (compile load eval) (ct_load 'sema))     ; contains vital MACRO

(eval-when (compile load eval) (ct_load 'pser))     ; contains vital MACRO
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compiler Declarations and Global Variables -- 
	
#+franz (declare (macros t))
(declare (ct_includef 'intrpdcl))		; get the specials
(eval-when (compile load eval) (ct_load 'ferec))	; get the macros etc.


;;;-- 6.  Subprograms
;;;-- ===============
;;;-- 6.1  Subprogram Declarations
;;;-- Syntax 6.1.A
;;;--  subprogram_declaration ::= subprogram_specification ';'
;;;--   | generic_subprogram_declaration
;;;--   | generic_subprogram_instantiation
;;;--
;;;
;;;    SUBPROGRAM_DEF ::=   void;
;;;
;;;    subprogram_decl =>   as_designator    : DESIGNATOR, -- one of 'entry_id',
;;;                                                   -- 'proc_id', 'function_id'
;;;                                                   -- or 'def_op'
;;;                         as_header        : HEADER,
;;;                         as_subprogram_def         : SUBPROGRAM_DEF;
;;;    subprogram_decl =>   lx_srcpos        : source_position,
;;;                         lx_comments      : comments;
;;;
;;;    DEF_ID ::=           proc_id;
;;;
;;;    proc_id =>           lx_srcpos        : source_position,
;;;                         lx_comments      : comments,
;;;                         lx_symrep        : symbol_rep;
;;;    proc_id =>           sm_spec          : HEADER,
;;;                         sm_body          : SUBP_BODY_DESC,
;;;                         sm_location      : LOCATION;
;;;
;;;    DEF_ID ::=           function_id;
;;;
;;;    function_id =>       lx_srcpos        : source_position,
;;;                         lx_comments      : comments,
;;;                         lx_symrep        : symbol_rep;
;;;    function_id =>       sm_spec          : HEADER,
;;;                         sm_body          : SUBP_BODY_DESC,
;;;                         sm_location      : LOCATION;
;;;
;;;    DEF_OP ::=           def_op;
;;;
;;;    def_op =>            lx_srcpos        : source_position,
;;;                         lx_comments      : comments,
;;;                         lx_symrep        : symbol_rep;
;;;    def_op =>            sm_spec          : HEADER,
;;;                         sm_body          : SUBP_BODY_DESC,
;;;                         sm_location      : LOCATION;
;;;
;;;    LANGUAGE ::=         argument_id;
;;;    LOCATION ::=         EXP_VOID | pragma_id;
;;;    SUBP_BODY_DESC ::=   block | stub | instantiation |
;;;                         FORMAL_SUBPROG_DEF | rename | LANGUAGE | void;
;;;-- 'pragma_id' and 'argument_id' only occur in the predefined environment
;;;
;;;-- Syntax 6.1.B
;;;--  subprogram_specification ::=
;;;--     'procedure' identifier [formal_part]
;;;--   | 'function'  designator [formal_part]
;;;--                               'return' subtype_indication
;;;--  designator ::= identifier | operator_symbol
;;;--  operator_symbol ::= character_string
;;;--
;;;
;;;
;;;    HEADER ::=           procedure;
;;;    HEADER ::=           function;
;;;    CONSTRAINED_VOID ::= CONSTRAINED | void;
;;;
;;;    procedure =>         as_param_s       : PARAM_S;
;;;    procedure =>         lx_srcpos        : source_position,
;;;                         lx_comments      : comments;
;;;
;;;    function =>          as_param_s       : PARAM_S,
;;;                         as_constrained_void       : CONSTRAINED_VOID;
;;;                                          -- void in case of instantiation
;;;    function =>          lx_srcpos        : source_position,
;;;                         lx_comments      : comments;
;;;
;;;-- Syntax 6.1.C
;;;--  formal_part ::=
;;;--     '(' parameter_declaration {';' parameter_declaration} ')'
;;;--  parameter_declaration ::=
;;;--     identifier_list ':' mode subtype_indication
;;;--                                       [':=' expression]
;;;--  mode  ::= ['in'] | 'out' | 'in' 'out'
;;;--
;;;
;;;
;;;    PARAM_S ::=          param_s;
;;;
;;;    param_s =>           as_list          : Seq Of PARAM;
;;;    param_s =>           lx_srcpos        : source_position,
;;;                         lx_comments      : comments;
;;;
;;;
;;;    PARAM ::=            pragma;          -- pragma allowed after ';'
;;;
;;;    PARAM ::=            in;
;;;
;;;    in =>                as_id_s          : ID_S,  -- always a sequence
;;;                                                   -- of 'in_id'
;;;                         as_type_spec     : TYPE_SPEC,
;;;                         as_exp_void      : EXP_VOID;
;;;    in =>                lx_srcpos        : source_position,
;;;                         lx_comments      : comments;
;;;
;;;
;;;    PARAM ::=            in_out;
;;;    PARAM ::=            out;
;;;
;;;    in_out =>            as_id_s          : ID_S,  -- always a sequence
;;;                                                   -- of 'in_out_id'
;;;                         as_type_spec     : TYPE_SPEC,
;;;                         as_exp_void      : EXP_VOID;   -- always void
;;;    in_out =>            lx_srcpos        : source_position,
;;;                         lx_comments      : comments;
;;;
;;;    out =>               as_id_s          : ID_S,  -- always a sequence
;;;                                                   -- of 'out_id'
;;;                         as_type_spec     : TYPE_SPEC,
;;;                         as_exp_void      : EXP_VOID;   -- always void
;;;    out =>               lx_srcpos        : source_position,
;;;                         lx_comments      : comments;
;;;
;;;    DEF_ID ::=           in_id;
;;;
;;;    in_id =>             lx_srcpos        : source_position,
;;;                         lx_comments      : comments,
;;;                         lx_symrep        : symbol_rep;
;;;    in_id =>             sm_obj_type      : TYPE_SPEC,
;;;                         sm_init_exp      : EXP_VOID;
;;;
;;;
;;;    DEF_ID ::=           in_out_id  |  out_id;
;;;
;;;    in_out_id =>         lx_srcpos        : source_position,
;;;                         lx_comments      : comments,
;;;                         lx_symrep        : symbol_rep;
;;;    in_out_id =>         sm_obj_type      : TYPE_SPEC;
;;;
;;;    out_id =>            lx_srcpos        : source_position,
;;;                         lx_comments      : comments,
;;;                         lx_symrep        : symbol_rep;
;;;    out_id =>            sm_obj_type      : TYPE_SPEC;
;;;
		;;;;;;;;;;;;;;;
(def_ada_syntax proc_param_decl
		;;;;;;;;;;;;;;;

	(pr_and 
	  (lambda(as)
	    (let ((identlist (cons (first as)(second as))))
	      (ct_selectq
		(first (fourth as))
		(dn_in
		  (sc_diana dn_in
			    as_id_s
			    (mapcar 
			      '(lambda(inid)	  ; formal in parameter.
				 (add_name
				   (diana_get inid 'lx_symrep)	  ; name
				   'formal_parameter
				   (let ((id
					   (sc_diana dn_in_id
						     lx_symrep
						     (diana_get inid 'lx_symrep)
						     sm_obj_type
						     (subtype_ind_init%sub_ind
						       (second (fourth as)))
						     )))
				     (diana_put id
						(diana_get
						  inid
						  'lx_srcpos)
						'lx_srcpos)
				     (diana_put id id 'sm_defn)
				     id)
				   nil))
			      identlist)
			    as_name (subtype_ind_init%sub_ind
				      (second (fourth as)))
			    as_exp_void (subtype_ind_init%initexp
					  (second (fourth as)))
			    ))
		(dn_in_out (sc_diana dn_in_out
				     as_id_s
				     (mapcar 
				       '(lambda(inid)	 ; formal in_out parameter.
					  (add_name
					    (diana_get inid 'lx_symrep)  ; name
					    'formal_parameter
					    (let ((id
						    (sc_diana dn_in_out_id
						      lx_symrep
						      (diana_get inid 'lx_symrep)
						      sm_obj_type
						      (second (fourth as))
						      )))
					      (diana_put id
							 (diana_get
							   inid
							   'lx_srcpos)
							 'lx_srcpos)
					      (diana_put id id 'sm_defn)
					      id)
					    nil))
				       identlist)
				     as_name (second (fourth as))))
		(dn_out (sc_diana dn_out
				  as_id_s ;
				  (mapcar 
				    '(lambda(inid); formal out parameter.
				       (add_name
					 (diana_get inid 'lx_symrep)	  ; name
					 'formal_parameter
					 (let ((id
						    (sc_diana dn_out_id
						      lx_symrep
						      (diana_get inid 'lx_symrep)
						      sm_obj_type
						      (second (fourth as))
						      )))
					      (diana_put id
							 (diana_get
							   inid
							   'lx_srcpos)
							 'lx_srcpos)
					      (diana_put id id 'sm_defn)
					      id)
					 nil))
				    identlist)
				  as_name (second (fourth as))))
		(otherwise
		  (lose 'fe_ppmode
			'proc_formal_param
			`("Fatal error in frontend - proc_formal_param")))
		)))
	  (pr_and
	    (lambda (as)
	      (let ((node
		      (sc_diana dn_in_id
				lx_symrep
				(first as))))
		(adjust_source_pos node -1 -1)
		node))
	    lex_ident)
	  (pr_repeat nil
		     (pr_or nil
			    (pr_and
			      (lambda(as)
				(gripe '("Probably comma omitted"))
				(first as))
			      (pr_and
				(lambda (as)
				  (let ((node
					  (sc_diana dn_in_id
						    lx_symrep
						    (first as))))
				    (adjust_source_pos node -1 -1)
				    node))
				lex_ident))
			    (pr_and cadr
				    oper_comma
				    (pr_and
				      (lambda (as)
					(let ((node
						(sc_diana dn_in_id
							  lx_symrep
							  (first as))))
					  (adjust_source_pos node -1 -1)
					  node))
				      lex_ident))))
	  (pr_or nil
		 (pr_and
		   (lambda(as)
		     (gripe '("Probably colon omitted"))
		     (putback_symbol (first as)))
		   (pr_or nil symb_in symb_out))
		 oper_colon)
	  (pr_or nil 
		 (pr_and
		   (lambda(as)
		     (cond ((and
			      (first as)
			      (null (extract_basetype (second as))))
			    (semgripe 'incomplete_type)))
		     (list 'dn_out (second as)))
		   symb_out 
		   subtype_indication)
		 (pr_and cadr
			 symb_in
			 (pr_or nil 
				(pr_and 
				  (lambda(as)
				    (cond ((and
					     (first as)
					     (null (extract_basetype (second as))))
					   (semgripe 'incomplete_type)))
				    (list 'dn_in_out (second as)))
				  symb_out
				  subtype_indication)
				(pr_and
				  (lambda(as)
				    (cond ((and
					     (subtype_ind_init%sub_ind
					       (first as))
					     (null (extract_basetype
						     (subtype_ind_init%sub_ind
						       (first as)))))
					   (semgripe 'incomplete_type)))
				    (list 'dn_in (first as)))
				  subtype_indication_init)))
		 (pr_and 
		   (lambda(as)
		     (cond ((and
			      (subtype_ind_init%sub_ind
				      (first as))
			      (null (extract_basetype
				      (subtype_ind_init%sub_ind
				      (first as)))))
				    (semgripe 'incomplete_type)))
		     (list 'dn_in (first as)))
		   subtype_indication_init))))
    
		;;;;;;;;;;;;;;;;
(def_ada_syntax funct_param_decl
		;;;;;;;;;;;;;;;;

	(pr_and
	  (lambda(as)
	    (let ((identlist (cons (first as)(second as))))
	      (sc_diana dn_in
			as_id_s
			(mapcar 
			  '(lambda(inid)  ; formal in parameter.
			     (add_name
			       (diana_get inid	'lx_symrep)  ; name
			       'formal_parameter
			       (let ((id
				       (sc_diana dn_in_id
						 lx_symrep
						 (diana_get inid 'lx_symrep)
						 sm_obj_type
						 (subtype_ind_init%sub_ind
						   (fifth as))
						 )))
				 (diana_put id
					    (diana_get
					      inid
					      'lx_srcpos)
					    'lx_srcpos)
				 (diana_put id id 'sm_defn)
				 id)
			       nil))
			  identlist)
			as_name (subtype_ind_init%sub_ind (fifth as))
			as_exp_void (subtype_ind_init%initexp (fifth as)))))
	  (pr_and
	    (lambda (as)
	      (let ((node
		      (sc_diana dn_in_id
				lx_symrep
				(first as))))
		(adjust_source_pos node -1 -1)
		node))
	    lex_ident)
	  (pr_repeat nil
		     (pr_or nil
			    (pr_and
			      (lambda(as)
				(gripe '("Probably comma omitted"))
				(first as))
			      (pr_and
				(lambda (as)
				  (let ((node
					  (sc_diana dn_in_id
						    lx_symrep
						    (first as))))
				    (adjust_source_pos node -1 -1)
				    node))
				lex_ident))
			    (pr_and cadr
				    oper_comma
				    (pr_and
				      (lambda (as)
					(let ((node
						(sc_diana dn_in_id
							  lx_symrep
							  (first as))))
					  (adjust_source_pos node -1 -1)
					  node))
				      lex_ident))))
	  oper_colon
	  (pr_or nil symb_in nil)
	  subtype_indication_init))
    
		;;;;;;;;;;;;;;;;;
(def_ada_syntax funct_formal_part
		;;;;;;;;;;;;;;;;;

	(pr_and 
	  (lambda(as)
	    (sc_diana dn_function
		      as_param_s	(cons (second as)(third as))))
	  oper_lparen
	  funct_param_decl
	  (pr_repeat 
	    nil
	    (pr_and cadr oper_semicolon funct_param_decl))
	  (pr_or nil
		 (pr_and
		   (lambda(as)
		     (gripe '("A right parenthesis was expected"))
		     (putback_symbol 'symb_is))
		   symb_is)
		 oper_rparen)))
    
		;;;;;;;;;;;;;;;;
(def_ada_syntax proc_formal_part
		;;;;;;;;;;;;;;;;

	(pr_and 
	  (lambda(as)			  ;(break in-proc-formal-part)
	    (sc_diana dn_procedure
		      as_param_s (cons (second as)(third as))))
	  oper_lparen
	  proc_param_decl
	  (pr_repeat nil (pr_and cadr oper_semicolon proc_param_decl))
	  (pr_or nil
		 (pr_and
		   (lambda(as)
		     (gripe '("A right parenthesis was expected"))
		     (putback_symbol 'symb_is))
		   symb_is)
		 oper_rparen)))

;;;-- 6.3  Subprogram Bodies
;;;
;;;-- Syntax 6.3
;;;--  subprogram_body ::=
;;;--     subprogram_specification 'is'
;;;--        declarative_part
;;;--    'begin'
;;;--        sequence_of_statements
;;;--   ['exception'
;;;--       {exception_handler}]
;;;--    'end' [designator] ';'
;;;--
;;;
;;;
;;;    BLOCK_STUB ::=       block;
;;;
;;;    subprogram_body =>   as_designator    : DESIGNATOR, -- one of 'proc_id',
;;;                                                   -- 'function_id' or 'def_op'
;;;                         as_header        : HEADER,
;;;                         as_block_stub    : BLOCK_STUB;
;;;    subprogram_body =>   lx_srcpos        : source_position,
;;;                         lx_comments      : comments;
;;;
		;;;;;;;;;
(def_ada_syntax body_part 	
		;;;;;;;;;

	(pr_or nil
	       (pr_and
		 (lambda(as)
		   (cond ((eq (second as) 'symb_end)
			  (sc_diana dn_block
				    as_item_s (first as)
				    as_stm_s ()))
			 (t (sc_diana dn_block
				      as_item_s (first as)
				      as_stm_s (car (second as))
				      as_alternative_s (cadr (second as))))))
		 declarative_part 
		 (pr_or nil (pr_in_block statement_part) symb_end))
	       (pr_and 
		 (lambda(as)
		   (sc_diana dn_block
			     as_item_s nil
			     as_stm_s (car (first as))
			     as_alternative_s (cadr (first as))))
		 (pr_in_block statement_part))))

;;;-- 6.4  Subprogram Calls
;;;
;;;-- Syntax 6.4
;;;--  procedure_call ::=
;;;--     name [actual_parameter_part] ';'
;;;--  function_call ::=
;;;--     name actual_parameter_part
;;;--  actual_parameter_part ::=
;;;--     '(' parameter_association {',' parameter_association}')'
;;;--  parameter_association ::=
;;;--     [formal_parameter '=>'] actual_parameter
;;;--  formal_parameter ::= identifier
;;;--  actual_parameter ::= expression
;;;--
;;;
;;;
;;;    STM ::=              procedure_call;
;;;
;;;    procedure_call =>    as_name          : NAME,
;;;                         as_param_assoc_s : PARAM_ASSOC_S;
;;;    procedure_call =>    lx_srcpos        : source_position,
;;;                         lx_comments      : comments;
;;;    procedure_call =>    sm_normalized_param_s     :EXP_S;
;;;
;;;    NAME ::=             function_call;
;;;
;;;    function_call =>     as_name          : NAME,
;;;                         as_param_assoc_s : PARAM_ASSOC_S;
;;;    function_call =>     lx_srcpos        : source_position,
;;;                         lx_comments      : comments;
;;;    function_call =>     sm_exp_type      : TYPE_SPEC,
;;;                         sm_value         : value,
;;;                         sm_normalized_param_s     :EXP_S;
;;;
;;;    PARAM_ASSOC ::=      EXP | assoc;
;;;
;;;    assoc =>             as_designator    : DESIGNATOR,
;;;                         as_actual        : ACTUAL;
;;;    assoc =>             lx_srcpos        : source_position,
;;;                         lx_comments      : comments;
;;;
;;;    ACTUAL ::=           EXP;
;;;
		;;;;;;;;;;;;;;;;;;;;;
(def_ada_syntax actual_parameter_part
		;;;;;;;;;;;;;;;;;;;;;

	(pr_or nil 
	       actual_parameter_part_formal
	       (pr_and
		 (lambda(as)		  ;(break in-actual_parameter_part)
		   (cons (first as)(second as)))
		 expression
		 (pr_or nil 
			(pr_and cadr
				oper_comma
				actual_parameter_part)
			nil))))
    
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def_ada_syntax actual_parameter_part_formal
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;

	(pr_and2
	  (lambda(as)			  ;(break in-actual_parameter_part_formal)
	    (cons
	      (sc_diana dn_assoc
			as_designator (first as)
			as_actual (third as))
	      (fourth as)))
	  lex_ident
;	    (pr_restrict formal_parameter lex_ident)
	  oper_goes
	  expression
	  (pr_or nil 
		 (pr_and cadr 
			 oper_comma
			 actual_parameter_part_formal
			 )
		 nil)))
    
;;;-- Syntax 9.5.B
;;;--  entry_call ::= name [actual_parameter_part] ';'
;;;--
;;;
;;;
;;;    STM ::=              entry_call;
;;;
;;;    entry_call =>        as_name          : NAME,
;;;                         as_param_assoc_s : PARAM_ASSOC_S;
;;;    entry_call =>        lx_srcpos        : source_position,
;;;                         lx_comments      : comments;
;;;    entry_call =>        sm_normalized_param_s     :EXP_S;
;;;
		;;;;;;;;;;;;;;;;;;;;;;;
(def_ada_syntax procedure_or_entry_call
		;;;;;;;;;;;;;;;;;;;;;;;
 
	(pr_or nil 
	       (pr_and 
		 (lambda(as) ;(break in_proc_or_entry_call)
		   (sc_diana dn_procedure_call
			     as_name nil  ;  gets filled in later.
			     as_param_assoc_s
			     (sc_diana dn_param_assoc_s
				       as_list (second as))
			     sm_normalized_param_s nil
			     ))
		 oper_lparen
		 (pr_or nil 
			(pr_and car procedure_or_entry_call_formal)
			;; this one MUST be first.
			(pr_and 
			  (lambda(as)
			    ;;(break in_procedure_or_entry_call_formal)
			    ;; assume  proc call for now.
			    (cons (first as)(second as)))
			  expression
			  (pr_or nil 
				 (pr_and cadr
					 oper_rparen
					 (pr_or nil 
						(pr_and cadr
							oper_lparen
							actual_parameter_part
							oper_rparen)
					  nil)
					 (pr_or nil
						oper_semicolon
						(pr_and
						  (lambda (as)
						    (semgripe 'illegal_assignment)
						    (do nil
							((eq la_current_symbol
							     'oper_semicolon) nil)
						      (la_lex))
						    (la_lex))
						  oper_assign)))
				 (pr_and cadr
					 oper_comma
					 actual_parameter_part
					 oper_rparen
					 (pr_or nil
						oper_semicolon
						(pr_and
						  (lambda (as)
						    (semgripe 'illegal_assignment)
						    (do nil
							((eq la_current_symbol
							     'oper_semicolon) nil)
						      (la_lex))
						    (la_lex))
						  oper_assign)))))
			(pr_or nil
			       (pr_and
				 (lambda (as)
				   (semgripe 'must_have_at_least_one_param)
				   (do nil
				       ((eq la_current_symbol
					    'oper_semicolon) nil)
				     (la_lex))
				   (la_lex)
				   nil)
				 oper_rparen)
			       nil)
			))
	       (pr_and
		 (lambda(as)
		   (sc_diana dn_procedure_call
			     as_name nil  ; gets filled in later.
			     as_param_assoc_s nil ; no parameters.
			     sm_normalized_param_s nil))
		 (pr_or nil
			oper_semicolon
			(pr_and
			  (lambda (as)
			    (semgripe 'illegal_assignment)
			    (do nil
				((eq la_current_symbol 'oper_semicolon) nil)
			      (la_lex))
			    (la_lex))
			  oper_assign)))))
    
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def_ada_syntax procedure_or_entry_call_formal
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

	(pr_and2 
	  (lambda(as)			  ; build me a list of assocs.
	    (cons			  ; first assoc
	      (sc_diana dn_assoc
			as_designator (first as)
			as_actual (third as))
	      (fourth as)))		  ; and all the rest.
	  lex_ident
;	    (pr_restrict formal_parameter lex_ident)
	  oper_goes
	  expression
	  (pr_or nil 
		 (pr_and (lambda(as) nil) oper_rparen oper_semicolon)
		 (pr_and cadr
			 oper_comma
			 procedure_or_entry_call_formal))))