;;; -*- mode:lisp;package:user;base:10.;fonts:(cptfontb) -*- 
;;;
;;;$Header: /ct/interp/dianods.l,v 1.18 84/11/19 13:07:52 penny Exp $

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                            DIANODS                               ;;;
;;; Mark Miller and Paul Robertson                          4-Jan-84 ;;;
;;;                                                                  ;;;
;;; 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, December 1983.  The CTAda Diana Users Manual (online). ;;;
;;;   Ambler & Trawick, Chatin's Graph Coloring Algorithm as a       ;;;
;;;     Method for Assigning Positions to Diana Attributes.          ;;;
;;;     SIGPLAN NOTICES, V18, #2, February 1983.                     ;;;
;;;   Robertson & Miller, 1982.  The C*T Diana Virtual Machine.      ;;;
;;;   Foderaro and Sklower, The FRANZ LISP Manual, September 1981.   ;;;
;;;   Weinreb and Moon, LISP MACHINE MANUAL, Symbolics, July 1981.   ;;;
;;;   Charniak et al., 1980.  Artificial Intelligence Programming.   ;;;
;;;   Miller, 1982.  The C*T Ada Tutor: Guide to the Implementation. ;;;
;;;   Tartan Labs, 1982.  The Diana Reference Manual.                ;;;
;;; The following code assumes familiarity with these materials.     ;;;
;;;                                                                  ;;;
;;; Please Note Well:                                                ;;;
;;;                                                                  ;;;
;;; Notice that a number of items are read-time conditionalized so   ;;;
;;; that they will only be seen when loading or compiling with       ;;;
;;; (sstatus feature diana_debugging) in effect.  These features     ;;;
;;; are only needed for debugging the Diana package, and are not     ;;;
;;; used sufficiently often to warrant using up extra space in the   ;;;
;;; actual system.  After setting this switch, it is necessary to    ;;;
;;; re-compile or re-load this file in order to cause these          ;;;
;;; features to become available.                                    ;;;
;;;                                                                  ;;;
;;; This documentation is now out of date.  ++Pass6                  ;;;
;;; Some symbols defined here are for internal use only.  The        ;;;
;;; following are the SUPPORTED features defined in this file:       ;;;
;;; See the self-contained Diana.Doc commentary for full details.    ;;;
;;;                                                                  ;;;
;;; All other symbols defined here are subject to change without     ;;;
;;; notice.  See Diana.Man for detailed specifications.              ;;;
;;;                                                                  ;;;
;;; Please do not rely on the internal representation of this        ;;;
;;; abstract datatype.                                               ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;		   Dependencies on External Files                    ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(comment assumes ctload and filemap)

(declare (ct_includef 'intrpdcl))

(eval-when (compile load eval) (ct_load 'charmac))
  ;;; One thing from charmac that we use heavily is the hash-
  ;;; dollar-period reader macro that expands to eval-when.

#$. (ct_load 'aip)			   ;AIP Macros pkg. 

#$. (ct_load 'compat)			   ;Compatibility Pkg.

#$. (ct_load 'ctio)			   ;Input-Output.

#$. (ct_load 'polly)			   ;Pure space stuff.

#$. (ct_load 'chunks)			   ;Hunk-like datatype.


;;; Since the attributes file might have been previously loaded but
;;; without full complr data, it may be necessary to use ct_reload
;;; instead of ct_load.  This mainly applies to the LISPM since the
;;; compiler and runtime environments live in the same world.

(eval-when (compile eval)
    (cond ((or (not (boundp '*diana_attributes*))
	       (null *diana_attributes*))
	   (ct_reload 'dianatts))))

(eval-when (load) (ct_load 'dianatts))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;	   Compiler Declarations and Global Variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#+franz (declare (macros t))		  ;Default only.

(declare (special *diana_nodetypes*))
  ;;; When debugging, *diana_nodetypes* provides a complete list
  ;;; of all legal CTAda Diana nodetype symbolic names.  There are
  ;;; approx. 167 standard ones and about a dozen ct-defined ones.
  ;;; The standard list was based on a hand-updated (to v3.0) version of
  ;;; the v1.0 manual from Tartan dated June 1982.
#$.
(setq *diana_nodetypes* nil)

(declare (special *dianods_status_flag*)) ;This file only.

      ;;;;;;;;;;;;;;;;;;;;;
(setq *dianods_status_flag*
      ;;;;;;;;;;;;;;;;;;;;;
      (or (status feature complr) (status feature diana_debugging)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;	Defining and Accessing Information about Diana Nodetypes     ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; A nodetype is a symbol with information on its plist.  Other than
;;; that, the representation is subject to change without notice.
;;; However, various access functions and/or macros are provided for
;;; accessing this information.  All definitions of nodetypes must occur
;;; in this file, so the macro for defining a new nodetype is not
;;; normally available at runtime.

       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun diana_nodetype_def_univ_filt (lst)	;;Internal use only.
       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (mapcan #'(lambda (a)
		      (and (not (diana_attribute_universalp a))
			   (pure-cons a nil)))
	    lst))

#+(and franz (not diana_debuggging))
(declare (macros nil)			  ;For next few.
	 (localf diana_nodetype_def_okp
		 diana_nodetype_def_arityp))

(eval-when (compile eval #+diana_debugging load)
         ;;;;;;;;;;;;;;;;;;;;;;;
  (defun diana_nodetype_def_okp (attlst group)
         ;;;;;;;;;;;;;;;;;;;;;;;
     ;;; Check legality of attributes in attlst, including what
     ;;; grouping they are supposed to be under and whether they
     ;;; are allowed to be universal.  Return t or nil.
     (do ((rst attlst (cdr rst))) ((null rst) t)
       (let* ((a (first rst)) (categ (diana_attribute_category a)))
	 (cond ((not (diana_attributep a))
		(format (error_output) "~&Datum not Diana Attribute:  ~S~%" a)
		(return nil))
	       ((not (or (and (eq group categ)
			      (memq group '(structural lexical semantic)))
                         ;;; Only code category attributes should be missing:
			 (and (eq group 'missing) (eq categ 'code))
			 ;;; Anything can be added extra to a node:
			 (eq group 'extra)))
		(format (error_output)
			"~&Diana Attribute in wrong category:  ~S~%" a)
		(return nil))
	       ((and (diana_attribute_universalp a)
		     ;;; The only standard universal attributes are lexical.
		     (not (or (eq group 'extra) (eq group 'lexical))))
		(format (error_output)
			"~&Diana Attribute cannot be universal:  ~S~%" a)
		(return nil)))))))


(eval-when (compile eval #+diana_debugging load)
         ;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun diana_nodetype_def_arityp (arity as)
         ;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;; Verify that declared arity is exactly consistent with what
    ;;; you would compute from structural sons data.  Especially
    ;;; important since arity is in fact not stored but recomputed.
    (let ((c (consp as)) (l (length as)))
      (declare (fixnum l))
      (ct_selectq arity
	(arbitrary (and c (= l 1) (eq (first as) 'as_list)))
	(unary     (and c (= l 1) (neq (first as) 'as_list)))
	(binary    (and c (= l 2)))
	(ternary   (and c (= l 3)))
	(nullary   (null as))
	(otherwise (lose 'wta 'diana_nodetype_def
		     `("~&Bad arity: ~S~%" arity)))))))


(eval-when (compile eval #+diana_debugging load)
         ;;;;;;;;;;;;;;;;;;
  (defun diana_nodetype_def macro (form)
         ;;;;;;;;;;;;;;;;;;
    ;;; For usage, see examples below.  Arguments are not eval'd.
    (let ((nodtyp   (second form))	  ;Name of the nodetype.
	  (tart     (third form))	  ;Whehter Tartan or CT devised.
          (arity    (fourth form))	  ;Eg binary.
	  (as       (fifth form))	  ;Structural Sons
	  (lx       (sixth form))	  ;Lexical Atts
	  (sm       (seventh form))       ;Semantic Atts
	  (extra    (eighth form))	  ;CT Extra Atts.
	  (missing  (ninth form)))	  ;Missing Atts {eg code_impl_size}.
	 (cond  ;;Verify the format and consistency of defining form.
	   ((and (= (length form) 9.)
		 (symbolp nodtyp)
		 (memq tart '(tartan ct))
		 ;;; Check that all universal attributes are allowed.
		 (do ((tail *diana_universal_attributes* (cdr tail)))
		     ((null tail) t) ;;All univs are lexicals or extras:
		     (or (memq (first tail) lx) (memq (first tail) extra)
			 (return nil)))
		 (diana_nodetype_def_okp as 'structural)
		 (diana_nodetype_def_okp lx 'lexical)
		 (diana_nodetype_def_okp sm 'semantic)
		 (diana_nodetype_def_okp extra 'extra)
		 (diana_nodetype_def_okp missing 'missing)
		 (diana_nodetype_def_arityp arity as))
	    (selfinsertmacro form
               ;;; Optionally push onto compile/debug list.  Flush info
	       ;;; about missing and tartanp fields for now to save space
	       ;;; in the runtime.  {Kept in defining forms for future ref.}
               `(progn 'compile
		   (and t ;*dianods_status_flag* do this always
			(not (memq ',nodtyp *diana_nodetypes*))
			(setq *diana_nodetypes*
			      (pure-cons ',nodtyp *diana_nodetypes*)))
		   (let ((aspur #+franz (purcopy ',as)	  ;Ptr to purcopy.
				#+lispm (apply #'pure-list ',as)))
 		    (pure-putprop ',nodtyp
		       (pure-cons
			  -1                 ;;Virtual size, uninitialized.
			  (pure-cons aspur   ;;Ptr to tail, shares structure.
			    (nconc #+franz (purcopy ',sm) ;No univs
				   #+lispm (apply #'pure-list ',sm)
				    (diana_nodetype_def_univ_filt ',lx)
				    (diana_nodetype_def_univ_filt ',extra)
				    aspur)))
		       'diana_nodetype_def)))))
	   (t (lose 'wta 'diana_nodetype_def
	       `("~&Wrong format in nodetype definition.~%~S~%" ',form)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Access Functions For Diana Nodetypes --

#+franz (declare (macros t))	;;Restore default.

#$.
         ;;;;;;;;;;;;;;;;;;;
(defun diana_nodetypep_int (frob)	  ;Internal-use-only
         ;;;;;;;;;;;;;;;;;;;
    (and (symbolp frob) (get frob 'diana_nodetype_def)))

#$.
         ;;;;;;;;;;;;;;;;
(defun diana_nodetypep macro (form)
         ;;;;;;;;;;;;;;;;
  ;;; (diana_nodetypep frob) can be called on an object of any
  ;;; type.  It will return non-nil iff the frob is an atomic
  ;;; symbol which is the name of a legal nodetype in ctada's
  ;;; version of Diana.  If a node is a legal Diana node reachable
  ;;; as the PC of the virtual machine, then it MUST be the name
  ;;; of a LISP function.  {That function is now kept in the normal 
  ;;; function cell, rather than on the property list as before.}
   (selfinsertmacro form
	 (let ((frob (cadr form)))
	   (cond			  ;Try for compile-time constant.
	     ((and (consp frob) (eq (car frob) 'quote))
	      `(quote ,(diana_nodetypep_int (cadr frob))))
	     ((symbolp frob)		  ;Multiple evaluation ok.
	      `(and (symbolp ,frob) (get ,frob 'diana_nodetype_def)))
	     (t `(diana_nodetypep_int ,frob))))))


         ;;;;;;;;;;;;;;;;;;;;
(defun diana_nodetypep_check (nodtyp fun)
         ;;;;;;;;;;;;;;;;;;;;
    (cond
      ((diana_nodetypep nodtyp) nodtyp)
      (t (lose 'wta fun
	       `("~&Datum should be Diana nodetype:  ~S~%" ,nodtyp))
	 nil)))

#$.
       ;;;;;;;;;;;;;;;;;;;;;;;;;
(defun diana_nodetype_structural macro (form)
       ;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;; Note that this is a {shared} tail of the full list of contingent atts.
  (selfinsertmacro form
    `(cadr (get ,(cadr form) 'diana_nodetype_def))))


       ;;;;;;;;;;;;;;;;;;;;
(defun diana_nodetype_arity (nodtyp)
       ;;;;;;;;;;;;;;;;;;;;
  ;;; Recompute from structural sons data, rather than storing redundantly.
  (let* ((as (diana_nodetype_structural nodtyp))
	 (l  (length as)))
    (cond ((= l 0) 'nullary)
	  ((= l 1) (cond ((eq (first as) 'as_list) 'arbitrary) (t 'unary)))
	  ((= l 2) 'binary)
	  ((= l 3) 'ternary)
	  (t (lose 'wta 'diana_nodetype_arity
		   `("~&Nodetype Arity Problem: ~S~%" ,nodtyp))))))

#$.
       ;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun diana_contingent_attributes macro (form)
       ;;;;;;;;;;;;;;;;;;;;;;;;;;;
       (selfinsertmacro form			  ;;User-callable.
	 `(cddr (get ,(cadr form) 'diana_nodetype_def))))

#$.
       ;;;;;;;;;;;;;;;;;
(defun diana_compatiblep (typ1 typ2)
       ;;;;;;;;;;;;;;;;;
   ;;; Non-NIL iff these two Diana nodetypes take exactly same attributes.
   ;;; This is used to force-fit, eg, dn_function_call and dn_used_name_id.
   (let ((c1 (diana_contingent_attributes typ1))
	 (c2 (diana_contingent_attributes typ2)))
    (do ((tl1 c1 (cdr tl1))
	 (tl2 c2 (cdr tl2)))
	((and (null tl1) (null tl2)) t)
      (cond ((not (memq (first tl1) c2)) (return nil))
	    ((not (memq (first tl2) c1)) (return nil))))))

       ;;;;;;;;;;;;;;;;;;;
(defun diana_nodetype_size macro (form)
       ;;;;;;;;;;;;;;;;;;;
  (selfinsertmacro form
    `(car (get ,(cadr form) 'diana_nodetype_def))))

       ;;;;;;;;;;;;;;;;;;;;;;;
(defun diana_nodetype_size_set macro (form)
       ;;;;;;;;;;;;;;;;;;;;;;;
  (selfinsertmacro form
    `(car (rplaca (get ,(cadr form) 'diana_nodetype_def)
		  ,(caddr form)))))

;;; End Diana NodeType Access Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Definitions of Diana Nodetypes.   First, Tartan Standard --

                    ;;;;;;;;
(diana_nodetype_def dn_abort tartan unary
                    ;;;;;;;;
		    (as_name_s)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_bnl ct_cont ct_generic_membership ct_id ct_time_stamp ct_nodetype
		     ct_pnl ct_posthook ct_prehook ct_threadp ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_accept tartan ternary
                    ;;;;;;;;;
		    (as_name as_param_s as_stm_s)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_access tartan unary
                    ;;;;;;;;;
		    (as_constrained)
		    (lx_srcpos lx_comments)
		    (sm_size sm_storage_size sm_controlled)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;
(diana_nodetype_def dn_address tartan binary
                    ;;;;;;;;;;
		    (as_name as_exp)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_aggregate tartan arbitrary
                    ;;;;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    (sm_exp_type sm_constraint sm_normalized_comp_s)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_index_list ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_alignment tartan binary
                    ;;;;;;;;;;;;
		    (as_pragma_s as_exp_void)
		    ()			  ;lx_comments, lx_srcpos not std
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     lx_comments lx_srcpos ct_late_attributes)
		    ())

                    ;;;;;;
(diana_nodetype_def dn_all tartan unary
                    ;;;;;;
		    (as_name)
		    (lx_srcpos lx_comments)
		    (sm_exp_type)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_allocator tartan unary
                    ;;;;;;;;;;;;
		    (as_exp_constrained)
		    (lx_srcpos lx_comments)
		    (sm_exp_type sm_value)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;
(diana_nodetype_def dn_alternative tartan binary
                    ;;;;;;;;;;;;;;
		    (as_choice_s as_stm_s)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_alternative_s tartan arbitrary
                    ;;;;;;;;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;
(diana_nodetype_def dn_and_then tartan nullary
                    ;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;
(diana_nodetype_def dn_argument_id tartan nullary
                    ;;;;;;;;;;;;;;
		    ()
		    (lx_symrep)		  ;lx_comments, lx_srcpos not std
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_value
		     ct_st_class ct_st_defining_block ct_st_type sm_first
		     lx_comments lx_srcpos sm_defn ct_late_attributes)
		    ())

                    ;;;;;;;;
(diana_nodetype_def dn_array tartan binary
                    ;;;;;;;;
		    (as_dscrt_range_s as_constrained)
		    (lx_srcpos lx_comments)
		    (sm_size sm_packing)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_assign tartan binary
                    ;;;;;;;;;
		    (as_name as_exp)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;
(diana_nodetype_def dn_assoc tartan binary
                    ;;;;;;;;
		    (as_designator as_actual)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_attribute tartan binary
                    ;;;;;;;;;;;;
		    (as_name as_id)
		    (lx_srcpos lx_comments)
		    (sm_exp_type sm_value)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_attribute_call tartan binary
                    ;;;;;;;;;;;;;;;;;
		    (as_name as_exp)
		    (lx_srcpos lx_comments)
		    (sm_exp_type sm_value)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;
(diana_nodetype_def dn_attr_id tartan nullary
                    ;;;;;;;;;;
		    ()
		    (lx_symrep)		  ;lx_comments, lx_srcpos not std
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_value
		     ct_st_class ct_st_defining_block ct_st_type sm_first
		     lx_comments lx_srcpos sm_defn ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_binary tartan ternary
                    ;;;;;;;;;
		    (as_exp1 as_binary_op as_exp2)
		    (lx_srcpos lx_comments)
		    (sm_exp_type sm_value)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;
(diana_nodetype_def dn_block tartan ternary
                    ;;;;;;;;
		    (as_item_s as_stm_s as_alternative_s)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;
(diana_nodetype_def dn_box tartan nullary
                    ;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;
(diana_nodetype_def dn_case tartan binary
                    ;;;;;;;
		    (as_exp as_alternative_s)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;
(diana_nodetype_def dn_choice_s tartan arbitrary
                    ;;;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;
(diana_nodetype_def dn_code tartan binary
                    ;;;;;;;
		    (as_name as_exp)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;
(diana_nodetype_def dn_compilation tartan arbitrary
                    ;;;;;;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;
(diana_nodetype_def dn_comp_id tartan nullary
                    ;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_obj_type sm_init_exp sm_comp_spec)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_first sm_value
		     ct_st_class ct_st_defining_block ct_st_type sm_defn
		     ct_late_attributes)
		    ())

                    ;;;;;;;;;;;
(diana_nodetype_def dn_comp_rep tartan ternary
                    ;;;;;;;;;;;
		    (as_name as_exp as_range)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;
(diana_nodetype_def dn_comp_rep_s tartan arbitrary
                    ;;;;;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_comp_unit tartan ternary
                    ;;;;;;;;;;;;
		    (as_context as_unit_body as_pragma_s)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;
(diana_nodetype_def dn_cond_clause tartan binary
                    ;;;;;;;;;;;;;;
		    (as_exp_void as_stm_s)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;
(diana_nodetype_def dn_cond_entry tartan binary
                    ;;;;;;;;;;;;;
		    (as_stm_s1 as_stm_s2)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;
(diana_nodetype_def dn_constant tartan ternary
                    ;;;;;;;;;;;
		    (as_id_s as_type_spec as_object_def)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;
(diana_nodetype_def dn_constrained tartan binary
                    ;;;;;;;;;;;;;;
		    (as_name as_constraint)
		    (lx_srcpos lx_comments)
		    (sm_type_struct sm_base_type sm_constraint)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    (cd_impl_size))


                    ;;;;;;;;;;;
(diana_nodetype_def dn_const_id tartan nullary
                    ;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_address sm_obj_type sm_obj_def sm_first)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_base_type ct_parent_type sm_defn
		     sm_init_exp    ;;++paul--we should use sm_obj_def instead!!
		     sm_value ct_late_attributes)
		    ())

                    ;;;;;;;;;;
(diana_nodetype_def dn_context tartan arbitrary
                    ;;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;
(diana_nodetype_def dn_conversion tartan binary
                    ;;;;;;;;;;;;;
		    (as_name as_exp)
		    (lx_srcpos lx_comments)
		    (sm_exp_type sm_value)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_decl_s tartan arbitrary
                    ;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_deferred_constant tartan binary
                    ;;;;;;;;;;;;;;;;;;;;
		    (as_id_s as_name)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;
(diana_nodetype_def dn_def_char tartan nullary
                    ;;;;;;;;;;;
  ;;; Note -- should have the "same shape" as a dn_enum_id.  A
  ;;; compatiblep check appears after that, below.
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_obj_type sm_pos sm_rep)
		    (sm_spec		  ;Used but non-std for this nodetype.
		     sm_first sm_value
		     ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl tp_vfuns
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_base_type ct_parent_type sm_defn ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_def_op tartan nullary
                    ;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_spec sm_body sm_location sm_stub sm_first)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;
(diana_nodetype_def dn_delay tartan unary
                    ;;;;;;;;
		    (as_exp)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;
(diana_nodetype_def dn_derived tartan unary
                    ;;;;;;;;;;
		    (as_constrained)
		    (lx_srcpos lx_comments)
		    (sm_size sm_actual_delta sm_packing
			     sm_controlled   sm_storage_size)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    (cd_impl_size))

                    ;;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_dscrmt_aggregate tartan arbitrary
                    ;;;;;;;;;;;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    (sm_normalized_comp_s)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_dscrmt_id tartan nullary
                    ;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_obj_type sm_init_exp sm_first sm_comp_spec)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_base_type ct_parent_type sm_defn sm_value
		     ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;
(diana_nodetype_def dn_dscrmt_var tartan ternary
                    ;;;;;;;;;;;;;
		    (as_id_s as_name as_object_def)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;
(diana_nodetype_def dn_dscrmt_var_s tartan arbitrary
                    ;;;;;;;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_dscrt_range_s tartan arbitrary
                    ;;;;;;;;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;
(diana_nodetype_def dn_entry tartan binary
                    ;;;;;;;;
		    (as_dscrt_range_void as_param_s)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;
(diana_nodetype_def dn_entry_call tartan binary
                    ;;;;;;;;;;;;;
		    (as_name as_param_assoc_s)
		    (lx_srcpos lx_comments)
		    (sm_normalized_param_s)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     tp_vfuns ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_late_attributes)
		    ())

                    ;;;;;;;;;;;
(diana_nodetype_def dn_entry_id tartan nullary
                    ;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_spec sm_address)
		    (ct_spec
		     ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_named_context sm_defn sm_first sm_value
		     ct_package_inner_environment ct_late_attributes)
		    ())


                    ;;;;;;;;;;
(diana_nodetype_def dn_enum_id tartan nullary
                    ;;;;;;;;;;
  ;;; NB: Must be kept compatible with dn_def_char.
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_obj_type sm_pos sm_rep)
		    (sm_spec		  ;Used but non-std for this nodetype.
		     sm_first
		     sm_value
		     ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl tp_vfuns
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_base_type ct_parent_type sm_defn ct_late_attributes)
		    ())

(or (diana_compatiblep 'dn_enum_id 'dn_def_char)
    (lose 'wta 'diana_nodetype_def
      `("~&Nodetypes dn_enum_id and dn_def_char are incompatible.~%")))

                    ;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_enum_literal_s tartan arbitrary
                    ;;;;;;;;;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    (sm_size)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    (cd_impl_size))



                    ;;;;;;;;;;;;
(diana_nodetype_def dn_exception tartan binary
                    ;;;;;;;;;;;;
		    (as_id_s as_exception_def)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;
(diana_nodetype_def dn_exception_id tartan nullary
                    ;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_exception_def)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_defn sm_first
		     ct_st_class ct_st_defining_block ct_st_type sm_value
		     ct_late_attributes)
		    ())

                    ;;;;;;;
(diana_nodetype_def dn_exit tartan binary
                    ;;;;;;;
		    (as_name_void as_exp_void)
		    (lx_srcpos lx_comments)
		    (sm_stm)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;
(diana_nodetype_def dn_exp_s tartan arbitrary
                    ;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;
(diana_nodetype_def dn_fixed tartan binary
                    ;;;;;;;;
		    (as_exp as_range_void)
		    (lx_srcpos lx_comments)
		    (sm_size sm_actual_delta sm_bits sm_base_type)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    (cd_impl_size))

                    ;;;;;;;;
(diana_nodetype_def dn_float tartan binary
                    ;;;;;;;;
		    (as_exp as_range_void)
		    (lx_srcpos lx_comments)
		    (sm_size sm_type_struct sm_base_type)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    (cd_impl_size))

                    ;;;;;;
(diana_nodetype_def dn_for tartan binary
                    ;;;;;;
		    (as_id as_dscrt_range)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;
(diana_nodetype_def dn_formal_dscrt tartan nullary
                    ;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;
(diana_nodetype_def dn_formal_fixed tartan nullary
                    ;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;
(diana_nodetype_def dn_formal_float tartan nullary
                    ;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_formal_integer tartan nullary
                    ;;;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;
(diana_nodetype_def dn_function tartan binary
                    ;;;;;;;;;;;
		    (as_param_s as_name_void)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_function_call tartan binary
                    ;;;;;;;;;;;;;;;;
  ;;; NB:  In CTAda this nodetype must be kept COMPATIBLE with
  ;;; dn_used_name_id, since the nodetype can change from one to
  ;;; other, AFTER a token node has been constructed.  That is, the
  ;;; two nodetypes are required to accept EXACTLY THE SAME SET OF
  ;;; ATTRIBUTES.  Thus, the fourth attlist-arg (attributes allowed by
  ;;; CTAda for this node that are not allowed by Tartan for this node)
  ;;; must INCLUDE all attributes required for the OTHER node that are
  ;;; not normally required for this node.  IF YOU EDIT THIS NODETYPE
  ;;; DEFINITION, PLEASE UPDATE THE *OTHER* ONE's NON-STANDARD ATTRIBUTES
  ;;; LIST SUCH THAT THIS CONSTRAINT IS MAINTAINED.  After dn_used_name_id
  ;;; is defined below, a compatiblep check is performed {at load time}.
		    (as_name as_param_assoc_s)
		    (lx_srcpos lx_comments lx_prefix)
		    (sm_exp_type sm_value sm_normalized_param_s)
		    (lx_symrep sm_first sm_defn tp_vfuns ct_nodetype
		     as_exp_s			  ;Non-std {CT} Structural
		     ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;
(diana_nodetype_def dn_function_id tartan nullary
                    ;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_spec sm_body sm_location sm_stub sm_first)
		    (ct_spec
		      ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_defn sm_value
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_named_context ct_base_type ct_parent_type
		     ct_package_inner_environment ct_late_attributes)
		    ())

                    ;;;;;;;;;;
(diana_nodetype_def dn_generic tartan ternary
                    ;;;;;;;;;;
		    (as_id as_generic_param_s as_generic_header)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_generic_assoc_s tartan arbitrary
                    ;;;;;;;;;;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;
(diana_nodetype_def dn_generic_id tartan nullary
                    ;;;;;;;;;;;;;
		    ()
		    (lx_symrep lx_srcpos lx_comments)
		    (sm_generic_param_s sm_spec sm_body sm_first sm_stub)
		    (ct_spec
		      ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_named_context ct_hidden_context sm_defn
		     ct_existing_instantiations sm_value
		     ct_package_inner_environment ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_generic_param_s tartan arbitrary
                    ;;;;;;;;;;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_existing_instantiations
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;
(diana_nodetype_def dn_goto tartan unary
                    ;;;;;;;
		    (as_name)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_name
		     ct_late_attributes)
		    ())

                    ;;;;;;;
(diana_nodetype_def dn_id_s tartan arbitrary
                    ;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;
(diana_nodetype_def dn_if tartan arbitrary
                    ;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;
(diana_nodetype_def dn_in tartan ternary
                    ;;;;;
		    (as_id_s as_name as_exp_void)
		    (lx_srcpos lx_comments lx_default)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;
(diana_nodetype_def dn_index tartan unary
                    ;;;;;;;;
		    (as_name)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;
(diana_nodetype_def dn_inner_record tartan arbitrary
                    ;;;;;;;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_instantiation tartan binary
                    ;;;;;;;;;;;;;;;;
		    (as_name as_generic_assoc_s)
		    (lx_srcpos lx_comments)
		    (sm_decl_s)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;
(diana_nodetype_def dn_integer tartan unary
                    ;;;;;;;;;;
		    (as_range)
		    (lx_srcpos lx_comments)
		    (sm_size sm_type_struct sm_base_type)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    (cd_impl_size))

                    ;;;;;;;;
(diana_nodetype_def dn_in_id tartan nullary
                    ;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_obj_type sm_init_exp sm_first)
		    (sm_defn sm_address sm_obj_def	  ;Non-std usage
		     ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_value
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())
;;; Verify that dn_in_id's can transmute into dn_const_id's:
(or (diana_compatiblep 'dn_in_id 'dn_const_id)
    (lose 'wta 'diana_nodetype_def
     `("~&Nodetypes dn_in_id and dn_const_id are incompatible.~%")))


                    ;;;;;;;;
(diana_nodetype_def dn_in_op tartan nullary
                    ;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_in_out tartan ternary
                    ;;;;;;;;;
		    (as_id_s as_name as_exp_void)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_in_out_id tartan nullary
                    ;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_obj_type sm_first)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_defn sm_value
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_item_s tartan arbitrary
                    ;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;
(diana_nodetype_def dn_iteration_id tartan nullary
                    ;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_obj_type)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_defn sm_first
		     ct_st_class ct_st_defining_block ct_st_type sm_value
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;
(diana_nodetype_def dn_labeled tartan binary
                    ;;;;;;;;;;
		    (as_id_s as_stm)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     as_id		   ;++paul -- to be removed later
		     ct_late_attributes)
		    ())

                    ;;;;;;;;;;;
(diana_nodetype_def dn_label_id tartan nullary
                    ;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_stm)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_named_context sm_defn sm_first
		     sm_value ct_st_class ct_st_defining_block ct_st_type
		     as_stm		   ;++paul -- temporary
		     ct_labeled
		     ct_late_attributes)
		    ())

                    ;;;;;;;
(diana_nodetype_def dn_loop tartan binary
                    ;;;;;;;
		    (as_iteration as_stm_s)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_l_private tartan nullary
                    ;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    (sm_discriminants)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_l_private_type_id tartan nullary
                    ;;;;;;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_type_spec)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_value
		     ct_st_class ct_st_defining_block ct_st_type
		     as_type_spec	  ;++paul should be sm_type_spec??
		     ct_base_type ct_parent_type sm_defn sm_first
		     ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;
(diana_nodetype_def dn_membership tartan ternary
                    ;;;;;;;;;;;;;
		    (as_exp as_membership_op as_type_range)
		    (lx_srcpos lx_comments)
		    (sm_exp_type sm_value)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;
(diana_nodetype_def dn_named tartan binary
                    ;;;;;;;;
		    (as_choice_s as_exp)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_named_stm tartan binary
                    ;;;;;;;;;;;;
		    (as_id as_stm)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;
(diana_nodetype_def dn_named_stm_id tartan nullary
                    ;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_stm)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_named_context sm_defn sm_first
		     sm_value ct_st_class ct_st_defining_block ct_st_type
		     ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_name_s tartan arbitrary
                    ;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_not_in tartan nullary
                    ;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;
(diana_nodetype_def dn_no_default tartan nullary
                    ;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;
(diana_nodetype_def dn_null_access tartan nullary
                    ;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    (sm_exp_type sm_value)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_null_comp tartan nullary
                    ;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;
(diana_nodetype_def dn_null_stm tartan nullary
                    ;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_number tartan binary
                    ;;;;;;;;;
		    (as_id_s as_exp)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     as_type_spec	  ;++paul ??
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_number_id tartan nullary
                    ;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_obj_type sm_init_exp)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_defn sm_first
		     ct_st_class ct_st_defining_block ct_st_type sm_value
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_numeric_literal tartan nullary
                    ;;;;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_numrep)
		    (sm_exp_type sm_value)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;
(diana_nodetype_def dn_or_else tartan nullary
                    ;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_others tartan nullary
                    ;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;
(diana_nodetype_def dn_out tartan ternary
                    ;;;;;;
		    (as_id_s as_name as_exp_void)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_out_id tartan nullary
                    ;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_obj_type sm_first)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_defn sm_value
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;
(diana_nodetype_def dn_package_body tartan binary
                    ;;;;;;;;;;;;;;;
		    (as_id as_block_stub)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;
(diana_nodetype_def dn_package_decl tartan binary
                    ;;;;;;;;;;;;;;;
		    (as_id as_package_def)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;
(diana_nodetype_def dn_package_id tartan nullary
                    ;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_spec sm_body sm_address sm_stub sm_first)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_defn sm_value
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_named_context ct_hidden_context
		     ct_package_inner_environment ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;
(diana_nodetype_def dn_package_spec tartan binary
                    ;;;;;;;;;;;;;;;
		    (as_decl_s1 as_decl_s2)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_param_assoc_s tartan arbitrary
                    ;;;;;;;;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;
(diana_nodetype_def dn_param_s tartan arbitrary
                    ;;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_parenthesized tartan unary
                    ;;;;;;;;;;;;;;;;
		    (as_exp)
		    (lx_srcpos lx_comments)
		    (sm_exp_type sm_value)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_pragma tartan binary
                    ;;;;;;;;;
		    (as_id as_param_assoc_s)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_pragma_id tartan arbitrary
                    ;;;;;;;;;;;;
		    (as_list)
		    (lx_symrep)		  ;lx_comments, lx_srcpos not std
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_defn sm_first
		     ct_st_class ct_st_defining_block ct_st_type sm_value
		     lx_comments lx_srcpos ct_late_attributes)
		    ())

                    ;;;;;;;;;;;
(diana_nodetype_def dn_pragma_s tartan arbitrary
                    ;;;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;
(diana_nodetype_def dn_private tartan nullary
                    ;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    (sm_discriminants)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_private_type_id tartan nullary
                    ;;;;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_type_spec)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_defn sm_first
		     ct_st_class ct_st_defining_block ct_st_type sm_value
		     as_type_spec	  ;++paul should be sm_type_spec
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_procedure tartan unary
                    ;;;;;;;;;;;;
		    (as_param_s)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_procedure_call tartan binary
                    ;;;;;;;;;;;;;;;;;
		    (as_name as_param_assoc_s)
		    (lx_srcpos lx_comments)
		    (sm_normalized_param_s)
		    (tp_vfuns ct_nodetype ct_generic_membership
		     ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;
(diana_nodetype_def dn_proc_id tartan nullary
                    ;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_spec sm_body sm_location sm_stub sm_first)
		    (ct_spec
		      ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_defn sm_value
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_named_context
		     ct_package_inner_environment ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_qualified tartan binary
                    ;;;;;;;;;;;;
		    (as_name as_exp)
		    (lx_srcpos lx_comments)
		    (sm_exp_type sm_value)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;
(diana_nodetype_def dn_raise tartan unary
                    ;;;;;;;;
		    (as_name_void)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;
(diana_nodetype_def dn_range tartan binary
                    ;;;;;;;;
		    (as_exp1 as_exp2)
		    (lx_srcpos lx_comments)
		    (sm_base_type)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_record tartan arbitrary
                    ;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    (sm_size sm_discriminants sm_packing sm_record_spec)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_named_context
		     ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;
(diana_nodetype_def dn_record_rep tartan ternary
                    ;;;;;;;;;;;;;
		    (as_name as_alignment as_comp_rep_s)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_rename tartan unary
                    ;;;;;;;;;
		    (as_name)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_return tartan unary
                    ;;;;;;;;;
		    (as_exp_void)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;
(diana_nodetype_def dn_reverse tartan binary
                    ;;;;;;;;;;
		    (as_id as_dscrt_range)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_select tartan binary
                    ;;;;;;;;;
		    (as_select_clause_s as_stm_s)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;
(diana_nodetype_def dn_selected tartan binary
                    ;;;;;;;;;;;
		    (as_name as_designator_char)
		    (lx_srcpos lx_comments)
		    (sm_exp_type)
		    (tp_vfuns
		     ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_value
		     ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_select_clause tartan binary
                    ;;;;;;;;;;;;;;;;
		    (as_exp_void as_stm_s)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_select_clause_s tartan arbitrary
                    ;;;;;;;;;;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;
(diana_nodetype_def dn_simple_rep tartan binary
                    ;;;;;;;;;;;;;
		    (as_name as_exp)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;
(diana_nodetype_def dn_slice tartan binary
                    ;;;;;;;;
		    (as_name as_dscrt_range)
		    (lx_srcpos lx_comments)
		    (sm_exp_type sm_constraint)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;
(diana_nodetype_def dn_stm_s tartan arbitrary
                    ;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_string_literal tartan nullary
                    ;;;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_exp_type sm_constraint sm_value)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;
(diana_nodetype_def dn_stub tartan nullary
                    ;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_subprogram_body tartan ternary
                    ;;;;;;;;;;;;;;;;;;
		    (as_designator as_header as_block_stub)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_subprogram_decl tartan ternary
                    ;;;;;;;;;;;;;;;;;;
		    (as_designator as_header as_subprogram_def)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;
(diana_nodetype_def dn_subtype tartan binary
                    ;;;;;;;;;;
		    (as_id as_constrained)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;
(diana_nodetype_def dn_subtype_id tartan nullary
                    ;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_type_spec)
		    (ct_named_context
		      ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_defn sm_first
		     ct_st_class ct_st_defining_block ct_st_type sm_value
		     as_type_spec	  ;++paul should be sm_type_spec
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;
(diana_nodetype_def dn_subunit tartan binary
                    ;;;;;;;;;;
		    (as_name as_subunit_body)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_task_body tartan binary
                    ;;;;;;;;;;;;
		    (as_id as_block_stub)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;
(diana_nodetype_def dn_task_body_id tartan nullary
                    ;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_type_spec sm_body sm_first sm_stub)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_defn sm_value
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_task_decl tartan binary
                    ;;;;;;;;;;;;
		    (as_id as_task_def)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_task_spec tartan unary
                    ;;;;;;;;;;;;
		    (as_decl_s)
		    (lx_srcpos lx_comments)
		    (sm_body sm_address sm_storage_size)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_terminate tartan nullary
                    ;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;
(diana_nodetype_def dn_timed_entry tartan binary
                    ;;;;;;;;;;;;;;
		    (as_stm_s1 as_stm_s2)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;
(diana_nodetype_def dn_type tartan ternary
                    ;;;;;;;
		    (as_id as_dscrmt_var_s as_type_spec)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;
(diana_nodetype_def dn_type_id tartan nullary
                    ;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_type_spec sm_first)
		    (ct_named_context
		     ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_defn sm_value
		     ct_st_class ct_st_defining_block ct_st_type
		     as_type_spec	  ;++paul should be sm_type_spec
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_universal_fixed tartan nullary
                    ;;;;;;;;;;;;;;;;;;
		    ()
		    ()			  ;lx_comments, lx_srcpos not std
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     lx_comments lx_srcpos ct_base_type ct_parent_type
		     ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_universal_integer tartan nullary
                    ;;;;;;;;;;;;;;;;;;;;
		    ()
		    ()			  ;lx_comments, lx_srcpos not std
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     lx_comments lx_srcpos ct_base_type ct_parent_type
		     ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_universal_real tartan nullary
                    ;;;;;;;;;;;;;;;;;
		    ()
		    ()			  ;lx_comments, lx_srcpos not std
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     lx_comments lx_srcpos ct_base_type ct_parent_type
		     ct_late_attributes)
		    ())

                    ;;;;;;
(diana_nodetype_def dn_use tartan arbitrary
                    ;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;
(diana_nodetype_def dn_used_bltn_id tartan nullary
                    ;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_operator)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_defn sm_first
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_base_type ct_parent_type sm_value ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;
(diana_nodetype_def dn_used_bltn_op tartan nullary
                    ;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_operator)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_used_char tartan nullary
                    ;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_defn sm_exp_type sm_value)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;
(diana_nodetype_def dn_used_name_id tartan nullary
                    ;;;;;;;;;;;;;;;
  ;;; NB:  In CTAda this nodetype must be kept COMPATIBLE with
  ;;; dn_function_call, since the nodetype can change from one to
  ;;; other, AFTER a token node has been constructed.  That is, the
  ;;; two nodetypes are required to accept EXACTLY THE SAME SET OF
  ;;; ATTRIBUTES.  Thus, the fourth attlist arg (attributes allowed by
  ;;; CTAda for this node that are not allowed by Tartan for this node)
  ;;; supplies attributes required for the other node that are not
  ;;; normally required for this node.  IF YOU EDIT THIS NODETYPE
  ;;; DEFINITION, PLEASE UPDATE THE OTHER ONE's NON-STANDARD ATTRIBUTES
  ;;; LIST SUCH THAT THIS CONSTRAINT IS MAINTAINED.
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_defn)		          ;Std Tartan Semantic
		    (as_name as_param_assoc_s	  ;Non-std {CT} Structural
		     as_exp_s			  ;Non-std {CT} Structural
		     lx_prefix		          ;Non-std {CT} Lexical
		     sm_exp_type                  ;Non-std {CT} Semantic
		     sm_first
		     sm_value
		     sm_normalized_param_s
		     tp_vfuns
		     ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

;;; Verify that used_name_id's can transmute into function calls:
(or (diana_compatiblep 'dn_used_name_id 'dn_function_call)
    (lose 'wta 'diana_nodetype_def
     `("~&Nodetypes dn_used_name_id and dn_function_call are incompatible.~%")))

                    ;;;;;;;;;;
(diana_nodetype_def dn_indexed tartan nullary
                    ;;;;;;;;;;
  ;;; NB:  In CTAda this nodetype must be kept COMPATIBLE with
  ;;; dn_function_call, since the nodetype can change from one to
  ;;; other, AFTER a token node has been constructed.  That is, the
  ;;; two nodetypes are required to accept EXACTLY THE SAME SET OF
  ;;; ATTRIBUTES.  Thus, the fourth attlist arg (attributes allowed by
  ;;; CTAda for this node that are not allowed by Tartan for this node)
  ;;; supplies attributes required for the other node that are not
  ;;; normally required for this node.  IF YOU EDIT THIS NODETYPE
  ;;; DEFINITION, PLEASE UPDATE THE OTHER ONE's NON-STANDARD ATTRIBUTES
  ;;; LIST SUCH THAT THIS CONSTRAINT IS MAINTAINED.
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_defn)		          ;Std Tartan Semantic
		    (as_name as_param_assoc_s	  ;Non-std {CT} Structural
		     as_exp_s			  ;Non-std {CT} Structural
		     lx_prefix		          ;Non-std {CT} Lexical
		     sm_exp_type                  ;Non-std {CT} Semantic
		     sm_first
		     sm_value
		     sm_normalized_param_s
		     tp_vfuns
		     ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

;;; Verify that indexed's can transmute into function calls:
(or (diana_compatiblep 'dn_indexed 'dn_function_call)
    (lose 'wta 'diana_nodetype_def
     `("~&Nodetypes dn_indexed and dn_function_call are incompatible.~%")))

                    ;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_used_object_id tartan nullary
                    ;;;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_exp_type sm_defn sm_value)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl sm_first
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;;;;;
(diana_nodetype_def dn_used_op tartan nullary
                    ;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_defn)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

                    ;;;;;;
(diana_nodetype_def dn_var tartan ternary
                    ;;;;;;
		    (as_id_s as_type_spec as_object_def)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())

;;; DN_VAR_S was in Tartan v2.1, but not Tartan v3.
;;; (diana_nodetype_def dn_var_s ... ) -- moved to CT Nodetypes

                    ;;;;;;;;;;
(diana_nodetype_def dn_variant tartan binary
                    ;;;;;;;;;;
		    (as_choice_s as_record)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;
(diana_nodetype_def dn_variant_part tartan binary
                    ;;;;;;;;;;;;;;;
		    (as_name as_variant_s)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;
(diana_nodetype_def dn_variant_s tartan arbitrary
                    ;;;;;;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;
(diana_nodetype_def dn_var_id tartan nullary
                    ;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_obj_type sm_address sm_obj_def)
		    (ct_named_context
		     sm_defn		  ;Non-std {CT} usage.
		     sm_first		  ;ditto
		     ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_st_class ct_st_defining_block ct_st_type
		     ct_base_type ct_parent_type sm_value ct_late_attributes)
		    ())

                    ;;;;;;;
(diana_nodetype_def dn_void tartan nullary
                    ;;;;;;;
		    ()
		    ()			  ;lx_srcpos, lx_comments not std
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     lx_srcpos lx_comments ct_late_attributes)
		    ())

                    ;;;;;;;;
(diana_nodetype_def dn_while tartan unary
                    ;;;;;;;;
		    (as_exp)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;
(diana_nodetype_def dn_with tartan arbitrary
                    ;;;;;;;
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

;;; End of Tartan Labs Standard Diana Nodetypes, CT nodetypes follow.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Remaining Diana Nodetypes Only Defined in CTAda Implementation.


                    ;;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_already_in_there ct nullary
                    ;;;;;;;;;;;;;;;;;;;
   ;;; A node to help Diana tree input-output.  No contingent attributes.
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_character_literal ct nullary
                    ;;;;;;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments lx_symrep)
		    ()
		    (sm_exp_type
		     ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;
(diana_nodetype_def dn_ct_lispcall ct nullary
                    ;;;;;;;;;;;;;;
   ;;; Call the specified LISP function.
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_function ct_nodetype ct_generic_membership
		     ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_ct_contextnode ct nullary
                    ;;;;;;;;;;;;;;;;;
   ;;; A node in the context hierarchy.
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_mixin_s ct_is_enclosed_by ct_pnl ct_bnl
		     ct_nodetype ct_generic_membership
		     ct_prehook ct_posthook ct_hidden_context
		     ct_id ct_time_stamp ct_threadp ct_cont ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_ct_exception_handler ct unary
                    ;;;;;;;;;;;;;;;;;;;;;;;
		    (as_stm_s)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_pnl ct_bnl ct_nodetype ct_generic_membership
		     ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_raising ct_resume
		     ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_ct_task_handler ct unary
                    ;;;;;;;;;;;;;;;;;
		    (as_stm_s)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_task_entry
		     ct_pnl ct_bnl ct_nodetype ct_generic_membership
		     ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_predefined_attribute ct nullary
                    ;;;;;;;;;;;;;;;;;;;;;;;
   ;;; A builtin Ada-attribute.
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_for
		     sm_first ct_st_class ct_st_type ct_st_defining_block
		     lx_symrep
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_predefined_function ct nullary
                    ;;;;;;;;;;;;;;;;;;;;;;
   ;;; A builtin function.
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_lisp_func ct_nodetype ct_generic_membership
		     ct_prehook ct_posthook
		     sm_first ct_st_class ct_st_type ct_st_defining_block
		     lx_symrep
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_predefined_procedure ct nullary
                    ;;;;;;;;;;;;;;;;;;;;;;;
   ;;; A  builtin procedure.
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_lisp_func ct_nodetype ct_generic_membership
		     ct_prehook ct_posthook
		     sm_first ct_st_class ct_st_type ct_st_defining_block
		     lx_symrep
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_predefined_simple_function ct nullary
                    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_lisp_func ct_nodetype ct_generic_membership
		     ct_prehook ct_posthook
		     sm_first ct_st_class ct_st_type ct_st_defining_block
		     lx_symrep
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_predefined_type ct unary
                    ;;;;;;;;;;;;;;;;;;
   ;;; An Ada primitive builtin type.
		    (as_dscrt_range_s)
		    (lx_srcpos lx_comments lx_symrep)
		    (sm_first)
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_lisp_func
		     ct_st_class ct_st_type ct_st_defining_block
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_predefined_exception ct nullary
                    ;;;;;;;;;;;;;;;;;;;;;;;
   ;;; An Ada builtin exception.
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     sm_first ct_st_class ct_st_type ct_st_defining_block
		     lx_symrep
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_predefined_pragma ct nullary
                    ;;;;;;;;;;;;;;;;;;;;
   ;;; An Ada builtin pragma.
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     sm_first ct_st_class ct_st_type ct_st_defining_block
		     lx_symrep
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_predefined_pragma_parameter ct nullary
                    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    ()
		    (ct_for ct_nodetype ct_generic_membership
		     ct_prehook ct_posthook
		     sm_first ct_st_class ct_st_type ct_st_defining_block
		     lx_symrep
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())

                    ;;;;;;;;;;;;;;;;;
(diana_nodetype_def dn_semantic_error ct nullary
                    ;;;;;;;;;;;;;;;;;
		    ()
		    (lx_srcpos lx_comments)
		    ()			  ;Should sm_wegot go here?
		    (sm_wegot		  ;Non-standard semantic attribute.
		     ct_nodetype ct_generic_membership
		     ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl ct_late_attributes)
		    ())



;;; DN_VAR_S commented out, obsolete, was renamed dn_dscrmt_var_s.
;;; For a while, CT kept using it, but no longer.  Kept around just
;;; in case we have overlooked some stray remaining users.  {Grepping
;;; over /ct/interp/latest/*.l does not reveal any users of this one.}

#|
                    ;;;;;;;;
(diana_nodetype_def dn_var_s ct arbitrary
                    ;;;;;;;;
  ;;; Previously (v2.1) defined by Tartan, then (v3) CT-defined only.
		    (as_list)
		    (lx_srcpos lx_comments)
		    ()
		    (ct_nodetype ct_generic_membership ct_prehook ct_posthook
		     ct_id ct_time_stamp ct_threadp ct_cont ct_pnl ct_bnl
		     ct_base_type ct_parent_type ct_late_attributes)
		    ())
|#

;;; End of Diana Nodetype Definitions.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;			UNUSED ACCESS FUNCTIONS                      ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#|

These three access functions are not currently supported since they are
not currently needed and would necessitate  a somewhat more cumbersome
nodetype representation.  However they could easily be added if needed,
by slightly changing the representation.  The information has been kept
available, just in case, in the notation for the diana_nodetype_def
forms.

(defun diana_nodetype_lexical macro (form) ... )

(defun diana_nodetype_semantic macro (form) ... )

(defun diana_nodetype_extra macro (form) ... )

(defun diana_nodetype_tartanp macro (form) ... )

|#


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;			      eof
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;