;;; -*- mode:lisp;package:user;base:10.;fonts:(cptfontb) -*- ;;; $Header: /ct/interp/adas150.l,v 1.10 84/04/02 14:13:14 penny Exp $ ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; adas150.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. ;;;-- 13. Representation Specifications and ;;;-- ===================================== ;;;-- Implementation Dependent Features ;;;-- ================================= ;;;-- 13.1 Representation Specifications ;;; ;;;-- Syntax 13.1 ;;;-- representation_specification ::= ;;;-- length_specification | enumeration_type_representation | ;;;-- record_type_representation | address_specification ;;;-- ;;; ;;; -- see below ;;; ;;;-- 13.2, 13.3 Length and Enumeration Type Specifications ;;; ;;;-- Syntax 13.2 ;;;-- length_specification ::= 'for' attribute 'use' expression';' ;;;-- enumeration_type_representation ::= ;;;-- 'for' name 'use' aggregate ';' ;;;-- ;;; ;;; ;;; REP ::= simple_rep; ;;; ;;; simple_rep => as_name : NAME, ;;; as_exp : EXP; ;;; simple_rep => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;;-- 13.4 Record Type Representations ;;; ;;;-- Syntax 13.4.A ;;;-- record_type_representation ::= ;;;-- 'for' name 'use' ;;;-- 'record' [alignment_clause ';'] ;;;-- component_clause {component_clause} ;;;-- 'end' 'record' ';' ;;;-- alignment_clause ::= 'at' 'mod' simple_expression ;;;-- ;;; ;;; ;;; REP ::= record_rep; ;;; ;;; ALIGNMENT ::= alignment; ;;; ;;; alignment => as_pragma_s : PRAGMA_S, -- pragma allowed ;;; -- in clause ;;; as_exp_void : EXP_VOID; ;;; ;;; record_rep => as_name : NAME, ;;; as_alignment : ALIGNMENT, ;;; as_comp_rep_s : COMP_REP_S; ;;; record_rep => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;;-- Syntax 13.4.B ;;;-- component_clause ::= name 'at' simple_expression 'range' range ;;;-- | null ;;;-- ;;; ;;; ;;; COMP_REP_S ::= comp_rep_s; ;;; COMP_REP ::= comp_rep | pragma | null_comp; -- pragma allowed ;;; -- in clause ;;; ;;; comp_rep_s => as_list : Seq Of COMP_REP; ;;; comp_rep_s => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;; comp_rep => as_name : NAME, ;;; as_exp : EXP, ;;; as_range : RANGE; ;;; comp_rep => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;;-- 13.5 Address Specifications ;;; ;;;-- Syntax 13.5 ;;;-- address_specification ::= ;;;-- 'for' simple_name 'use' 'at' simple_expression';' ;;;-- ;;; ;;; ;;; REP ::= address; ;;; ;;; address => as_name : NAME, ;;; as_exp : EXP; ;;; address => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;;;;;;;;;;;; (defun length_clause (as) ;;;;;;;;;;;;; (let ((attr (diana_get (diana_get (second as) 'as_name) 'as_id)) (type (extract_basetype (diana_get (diana_get (second as) 'as_name) 'as_name))) (stval (static_eval (fourth as)))) (ct_selectq (implode (cadr (diana_get attr 'lx_symrep))) (|size| ;exp must be static and integer (cond ((eq stval '*diana_node_not_static_expression*) (semgripe 'exp_must_be_static_in_length_size_clause)) ((not (assignment_compatible *universal_integer* (fourth as))) (semgripe 'exp_must_be_integer_type_for_size)) ((diana_node_accepts_attributep type 'sm_size) (diana_put type (fourth as) 'sm_size)))) (|storage_size| ;type must be an access or task type ;exp must be an integer (cond ((not (assignment_compatible *universal_integer* (fourth as))) (semgripe 'exp_must_be_integer_type_for_storage_size)) ((not (memq (diana_nodetype_get (diana_get (diana_get (diana_get (diana_get (second as) 'as_name) 'as_name) 'sm_defn) 'sm_type_spec)) '(dn_task_spec dn_access))) (semgripe 'type_must_be_access_or_task_type)) ((diana_node_accepts_attributep type 'sm_storage_size) (diana_put type (fourth as) 'sm_storage_size)))) (|small| ;must be fixed point type ;exp must static real type ;(break in-small) (cond ((eq stval '*diana_node_not_static_expression*) (semgripe 'exp_must_be_static_in_length_small_clause)) ((not (assignment_compatible *universal_real* (fourth as))) (semgripe 'exp_must_be_real_type_for_small)) ((diana_node_accepts_attributep type 'sm_actual_delta) (diana_put type (fourth as) 'sm_actual_delta)) )) (otherwise (semgripe 'not_a_legal_attribute_in_length_clause ))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def_ada_syntax representation_specification ;;;;;;;;;;;;;;;;;;;;;;;;;;;; (pr_and (lambda(as) (cond ((eq (car as) 'symb_at) (sc_diana dn_address as_name (second as) as_exp (second (fourth as)))) ((eq (car as) 'symb_record) (sc_diana dn_record_rep as_name (second as) as_alignment (cond ((null (second (fourth as))) (sc_diana dn_void)) (t (second (fourth as)))) as_comp_rep_s (sc_diana dn_comp_rep_s as_list (third (fourth as))))) ((and (second as) (eq (diana_nodetype_get (second as)) 'dn_attribute_call)) (length_clause as) (sc_diana dn_simple_rep as_name (second as) as_exp (fourth as))) ((and (second as) (eq (diana_nodetype_get (diana_get (diana_get (second as) 'sm_defn) 'sm_type_spec)) 'dn_record)) ;(break in-dn-record) (sc_diana dn_record_rep as_name (second as) as_alignment (cond ((null (second (fourth as))) (sc_diana dn_void)) (t (second (fourth as)))) as_comp_rep_s (sc_diana dn_comp_rep_s as_list (third (fourth as))))) (t (cond ((memq (diana_nodetype_get (diana_get (second as) 'sm_defn)) '(dn_type_id dn_subtype_id)) (diana_put (fourth as) (diana_get (diana_get (second as) 'sm_defn) 'sm_type_spec) 'sm_exp_type) (normalize_aggregate (fourth as)) (let ((elits (diana_get (diana_get (fourth as) 'sm_exp_type) 'as_list)) ;enum_lits (agglst (diana_get (diana_get (fourth as) 'sm_normalized_comp_s) 'as_list))) (mapc #'(lambda(el rp) (diana_put el rp 'sm_rep)) elits agglst)) )) (sc_diana dn_simple_rep as_name (second as) as_exp (fourth as))))) symb_for name symb_use (pr_or nil (pr_and car expression oper_semicolon) (pr_and nil symb_record (pr_or nil (pr_and (lambda(as) (sc_diana dn_alignment as_pragma_s nil ;; needs modification ; here to allow pragmas as_exp_void (third as))) symb_at symb_mod simple_expression oper_semicolon) nil) representation_specification_naka) (pr_and nil symb_at simple_expression oper_semicolon)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def_ada_syntax representation_specification_naka ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (pr_or nil (pr_and (lambda(as) (cons (sc_diana dn_comp_rep as_name (first as) as_exp (third as) as_range (fourth as)) (cadddddr as))) name;(pr_restrict component name) symb_at simple_expression range_constraint oper_semicolon representation_specification_naka) (pr_and (lambda(as) nil) symb_end symb_record oper_semicolon))) ;;;-- 2.3 Identifiers, 2.4 Numeric Literals, 2.6 Character Strings ;;; ;;;-- Syntax 2.3 ;;;-- not of interest for Diana ;;;-- ;;; ;;; ID ::= DEF_ID | USED_ID; ;;; ;;; OP ::= DEF_OP | USED_OP; ;;; ;;; DESIGNATOR ::= ID | OP; ;;; ;;; DEF_OCCURRENCE ::= DEF_ID | DEF_OP | DEF_CHAR; ;;; ;;;-- 3. Declarations and Types ;;;-- ========================== ;;;-- 3.1 Declarations ;;; ;;;-- Syntax 3.1 ;;;-- declaration ::= ;;;-- object_declaration | number_declaration ;;;-- | type_declaration | subtype_declaration ;;;-- | subprogram_declaration | package_declaration ;;;-- | task_declaration | exception_declaration ;;;-- | renaming_declaration | generic_declaration ;;;-- | pragma ;;;-- ;;; ;;; DECL ::= constant | var | number | type | subtype | ;;; subprogram_decl | package_decl | task_decl | ;;; exception | pragma | generic; ;;; ;;;-- 3.7.2 Discriminant Constraints ;;; ;;;-- Syntax 3.7.2 ;;;-- discriminant_constraint ::= ;;;-- '('discriminant_specification ;;;-- {',' discriminant_specification}')' ;;;-- discriminant_specification ::= ;;;-- [name {|name} '=>'] expression ;;;-- ;;; ;;; ;;; CONSTRAINT ::= dscrmt_aggregate; ;;; ;;; dscrmt_aggregate => as_list : Seq Of COMP_ASSOC; ;;; dscrmt_aggregate => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;;-- 3.7.3 Variant Parts ;;; ;;;-- Syntax 3.7.3.A ;;;-- variant_part ::= ;;;-- 'case' name 'is' ;;;-- {'when' choice {'|' choice} '=>' ;;;-- component_list} ;;;-- 'end' 'case' ';' ;;;-- ;;; ;;; ;;; variant_part => as_name : NAME, ;;; as_variant_s : VARIANT_S; ;;; variant_part => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;; ;;; VARIANT_S ::= variant_s; ;;; ;;; variant_s => as_list : Seq Of VARIANT; ;;; variant_s => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;; VARIANT ::= variant | pragma; -- pragma allowed before ;;; -- 'when' ;;; CHOICE_S ::= choice_s; ;;; INNER_RECORD ::= inner_record; ;;; ;;; choice_s => as_list : Seq Of CHOICE; ;;; choice_s => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;; variant => as_choice_s : CHOICE_S, ;;; as_record : INNER_RECORD; ;;; variant => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;; inner_record => as_list : Seq Of COMP; ;;; inner_record => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;;-- Syntax 3.7.3.B ;;;-- choice ::= simple_expression | discrete_range | 'others' ;;;-- ;;; ;;; ;;; CHOICE ::= EXP | DSCRT_RANGE | others; ;;; ;;; others => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;;-- 3.8 Access Types ;;; ;;;-- Syntax 3.8.A ;;;-- access_type_definition ::= 'access' subtype_indication ;;;-- ;;; ;;; ;;; TYPE_SPEC ::= access; ;;; ;;; access => as_constrained : CONSTRAINED; ;;; access => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; access => sm_size : EXP_VOID, ;;; sm_storage_size : EXP_VOID, ;;; sm_controlled : Boolean; ;;; access => cd_impl_size : Integer, ;;; cd_alignment : Integer; ;;; ;;;-- Syntax 3.8.B ;;;-- incomplete_type_declaration ::= ;;;-- 'type' identifier [discriminant_part]';' ;;;-- ;;; ;;; ;;; TYPE_SPEC ::= void; ;;; ;;; -- incomplete types are described in the rationale ;;; ;;;-- 4.1.1 Indexed Components ;;; ;;;-- Syntax 4.1.1 ;;;-- indexed_component ::= name '('expression {',' expression}')' ;;;-- ;;; ;;; ;;; EXP_S ::= exp_s; ;;; ;;; exp_s => as_list : Seq Of EXP; ;;; exp_s => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;; ;;; NAME ::= indexed; ;;; ;;; indexed => as_name : NAME, ;;; as_exp_s : EXP_S; ;;; indexed => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; indexed => sm_exp_type : TYPE_SPEC, ;;; sm_value : value; ;;; ;;;-- 4.1.2 Slices ;;; ;;;-- Syntax 4.1.2 ;;;-- slice ::= name '('discrete_range')' ;;;-- ;;; ;;; ;;; NAME ::= slice; ;;; ;;; slice => as_name : NAME, ;;; as_dscrt_range : DSCRT_RANGE; ;;; slice => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; slice => sm_exp_type : TYPE_SPEC, ;;; sm_constraint : CONSTRAINT, ;;; sm_value : value; ;;; ;;;-- 4.1.3 Selected Components ;;; ;;;-- Syntax 4.1.3 ;;;-- selected_component ::= ;;;-- name '.' identifier | name '.' 'all' ;;;-- name '.' operator_symbol | name '.' character_literal ;;;-- ;;; ;;; ;;; DESIGNATOR_CHAR ::= DESIGNATOR | used_char; ;;; -- character literals allowed in selected components ;;; NAME ::= selected; ;;; NAME ::= all; ;;; ;;; selected => as_name : NAME, ;;; as_designator_char : DESIGNATOR_CHAR; ;;; selected => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; selected => sm_exp_type : TYPE_SPEC, ;;; sm_value : value; ;;; ;;; ;;; all => as_name : NAME; ;;; all => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; all => sm_exp_type : TYPE_SPEC, ;;; sm_value : value; ;;; ;;;-- 4.1.4 Attributes ;;; ;;;-- Syntax 4.1.4 ;;;-- attribute ::= name '''' identifier ;;;-- | name '''' identifier '(' universal_static_expression ')' ;;;-- ;;; ;;; ;;; NAME ::= attribute | attribute_call; ;;; ;;; attribute => as_name : NAME, ;;; as_id : ID; -- always a 'used_name_id', ;;; -- whose attributes point to ;;; -- a predefined 'attr_id' ;;; attribute => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; attribute => sm_exp_type : TYPE_SPEC, ;;; sm_value : value; ;;; ;;; attribute_call => as_name : NAME, -- used for attributes ;;; -- with arguments ;;; as_exp_s : EXP_S; ;;; attribute_call => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; attribute_call => sm_exp_type : TYPE_SPEC, ;;; sm_value : value; ;;; ;;;-- 4.3 Aggregates ;;; ;;;-- Syntax 4.3.A ;;;-- aggregate ::= ;;;-- '('component_association {',' component_association}')' ;;;-- ;;; ;;; ;;; EXP ::= aggregate; ;;; ;;; aggregate => as_list : Seq Of COMP_ASSOC; ;;; aggregate => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; aggregate => sm_exp_type : TYPE_SPEC, ;;; sm_constraint : CONSTRAINT, ;;; sm_value : value; ;;; ;;;-- Syntax 4.3.B ;;;-- component_association ::= ;;;-- [choice {'|' choice} '=>' ] expression ;;;-- ;;; ;;; ;;; COMP_ASSOC ::= named | EXP; ;;; ;;; named => as_choice_s : CHOICE_S, ;;; as_exp : EXP; ;;; named => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;;-- 4.6 Type Conversions ;;; ;;;-- Syntax 4.6 ;;;-- type_conversion ::= type_mark '(' expression ')' ;;;-- ;;; ;;; ;;; EXP ::= conversion; ;;; ;;; conversion => as_name : NAME, ;;; as_exp : EXP; ;;; conversion => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; conversion => sm_exp_type : TYPE_SPEC, ;;; sm_value : value; ;;; ;;;-- 4.7 Qualified Expressions ;;; ;;;-- Syntax 4.7 ;;;-- qualified_expression ::= ;;;-- type_mark'''' '('expression')' | type_mark''''aggregate ;;;-- ;;; ;;; ;;; EXP ::= qualified; ;;; ;;; qualified => as_name : NAME, ;;; as_exp : EXP; ;;; qualified => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; qualified => sm_exp_type : TYPE_SPEC, ;;; sm_value : value; ;;; ;;;-- 4.8 Allocators ;;; ;;;-- Syntax 4.8 ;;;-- allocator ::= ;;;-- 'new' qualified_expression ;;;-- | 'new' type_mark [discriminant_constraint] ;;;-- | 'new' type_mark [index_constraint] ;;;-- ;;; ;;; ;;; EXP ::= allocator; ;;; ACCESS_CONSTRAINT::= EXP | DSCRT_RANGE_S | void | dscrmt_aggregate; ;;; ;;; allocator => as_name : NAME, ;;; as_access_constraint : ACCESS_CONSTRAINT; ;;; allocator => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; allocator => sm_exp_type : TYPE_SPEC, ;;; sm_value : value; ;;; ;;;-- Syntax 5.1.B ;;;-- statement ::= ;;;-- {label} simple_statement | {label} compound_statement ;;;-- ;;; ;;; ;;; STM ::= labeled; ;;; ;;; labeled => as_id : ID, -- always a 'label_id' ;;; as_stm : STM; ;;; labeled => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;; ;;; DEF_ID ::= label_id; ;;; ;;; label_id => lx_srcpos : source_position, ;;; lx_comments : comments, ;;; lx_symrep : symbol_rep; ;;; label_id => sm_stm : STM; -- always 'named' ;;; -- or 'labeled' ;;; ;;;-- Syntax 5.1.C ;;;-- simple_statement ::= null_statement ;;;-- | assignment_statement | exit_statement ;;;-- | return_statement | goto_statement ;;;-- | procedure_call | entry_call ;;;-- | delay_statement | abort_statement ;;;-- | raise_statement | code_statement ;;;-- | pragma ;;;-- ;;; ;;; -- see 5.1, 5.2, 5.7, 5.8, 5.9, 9.6, 9.10, 11.3, 13.8 ;;; ;;; STM ::= pragma; ;;; ;;;-- Syntax 5.1.D ;;;-- compound_statement ::= ;;;-- if_statement | case_statement ;;;-- | loop_statement | block ;;;-- | accept_statement | select_statement ;;;-- ;;; ;;; -- see 5.3, 5.4, 5.5, 9.5, 9.7 ;;; ;;;-- Syntax 5.1.E ;;;-- label ::= '<<' identifier '>>' ;;;-- ;;; ;;; -- see 5.1.B ;;; ;;;-- Syntax 5.1.F ;;;-- null_statement ::= 'null' ';' ;;;-- ;;; ;;; ;;; STM ::= null_stm; ;;; ;;; null_stm => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;;-- 5.2 Assignment Statement ;;; ;;;-- Syntax 5.2 ;;;-- assignment_statement ::= name ':=' expression ';' ;;;-- ;;; ;;; ;;; STM ::= assign; ;;; ;;; assign => as_name : NAME, ;;; as_exp : EXP; ;;; assign => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;;-- 7.4 Private Type Definitions ;;; ;;;-- Syntax 7.4 ;;;-- private_type_definition ::= ['limited'] 'private' ;;;-- ;;; ;;; ;;; TYPE_SPEC ::= private; ;;; TYPE_SPEC ::= l_private; ;;; ;;; private => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; private => sm_discriminants : VAR_S; ;;; l_private => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; l_private => sm_discriminants : VAR_S; ;;; ;;; DEF_ID ::= private_type_id | l_private_type_id; ;;; ;;; private_type_id => lx_srcpos : source_position, ;;; lx_comments : comments, ;;; lx_symrep : symbol_rep; ;;; private_type_id => sm_type_spec : TYPE_SPEC; ;;; -- Refers to the complete ;;; -- type specification of the ;;; -- private type. ;;; -- See rationale. ;;; ;;; l_private_type_id => lx_srcpos : source_position, ;;; lx_comments : comments, ;;; lx_symrep : symbol_rep; ;;; l_private_type_id => sm_type_spec : TYPE_SPEC; ;;; -- Refers to the complete ;;; -- type specification of the ;;; -- limited private type. ;;; -- See rationale. ;;; ;;;-- 8.5 Renaming Declarations ;;; ;;;-- Syntax 8.5 ;;;-- renaming_declaration ::= ;;;-- identifier ':' type_mark 'renames' name ';' ;;;-- | identifier ':' 'exception' 'renames' name ';' ;;;-- | 'package' identifier 'renames' name ';' ;;;-- | subprogram_specification 'renames' name ';' ;;;-- ;;; ;;; ;;; OBJECT_DEF ::= rename; ;;; EXCEPTION_DEF ::= rename; ;;; PACKAGE_DEF ::= rename; ;;; SUBPROGRAM_DEF ::= rename; ;;; ;;; rename => as_name : NAME; ;;; rename => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;;-- 11. Exceptions ;;;-- =============== ;;;-- 11.1 Exception Declarations ;;; ;;;-- Syntax 11.1 ;;;-- exception_declaration ::= identifier_list ':' 'exception' ';' ;;;-- ;;; ;;; ;;; EXCEPTION_DEF ::= void; ;;; ;;; exception => as_id_s : ID_S, -- 'exception_id' sequence ;;; as_exception_def : EXCEPTION_DEF; ;;; exception => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;; ;;; DEF_ID ::= exception_id; ;;; ;;; exception_id => lx_srcpos : source_position, ;;; lx_comments : comments, ;;; lx_symrep : symbol_rep; ;;; exception_id => sm_exception_def : EXCEPTION_DEF; ;;; ;;;-- 11.2 Exception Handlers ;;; ;;;-- Syntax 11.2 ;;;-- exception_handler ::= ;;;-- 'when' exception_choice {'|' exception_choice} '=>' ;;;-- sequence_of_statements ;;;-- exception_choice ::= name | 'others' ;;;-- ;;; ;;; -- see 5.4, 5.6, 3.7.3.B ;;; ;;;-- 13.8 Machine Code Insertions ;;; ;;;-- Syntax 13.8 ;;;-- code_statement ::= qualified_expression';' ;;;-- ;;; ;;; ;;; STM ::= code; ;;; ;;; code => as_name : NAME, ;;; as_exp : EXP; ;;; code => lx_srcpos : source_position, ;;; lx_comments : comments; ;;; ;;;-- 14.0 Input-Output ;;;-- ================= ;;;-- I/O procedure calls are not specially handled. They are ;;;-- represented by procedure or function calls (see 6.4). ;;; ;;;-- Predefined Diana Environment ;;;-- ============================ ;;;-- ;;;-- see Appendix I of this manual ;;;-- ;;; ;;; DEF_ID ::= attr_id | pragma_id | ARGUMENT; ;;; ARGUMENT ::= argument_id; ;;; ;;; attr_id => lx_symrep : symbol_rep; ;;; ;;; TYPE_SPEC ::= universal_integer | universal_fixed | universal_real; ;;; ;;; universal_integer => ; ;;; universal_fixed => ; ;;; universal_real => ; ;;; ;;; argument_id => lx_symrep : symbol_rep; ;;; ;;; pragma_id => as_list : Seq Of ARGUMENT; ;;; pragma_id => lx_symrep : symbol_rep; ;;; ;;; End ;;; ;;; ;;; eof ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; #| (cond ((eq (first (second as)) 'symb_body) ); what goes here? (t (let ((this_pkg (sc_diana dn_package_id lx_symrep (first (second as)) sm_spec (second (second as)) ))) (add_name (second as) ; name 'library_unit ; class (sc_diana dn_package_decl as_id this_pkg as_package_def (sc_diana dn_package_spec as_decl_s1 (second (second as)) as_decl_s2 nil) ) nil) (add_name (second as) ; name 'package ; class (sc_diana dn_package_decl as_id this_pkg as_package_def (sc_diana dn_package_spec as_decl_s1 (second (second as)) as_decl_s2 nil) ) nil)))) |#