;; Modified to remove the calls of DO-MUTUAL, which are now commented out.
;; The forms below them in capital letters are presumably the ones that DO-MUTUAL
;; generated.
;; See also the comment below the DEFN-SK event.

Event: Start with the library "gf".

; ********
;  Errors
; ********

Definition: entry not boolean error (e, sn) = mk error (list ('the,

'entry,
'specification,

e,

'in,
'scope,

sn,

'is,
'not,
'a,
'boolean-valued,
'expression))

Definition: exit label error (e, sn) = mk error (list ('the,

'exit,
'specification,

e,

'in,
'scope,

sn,

'has,
'duplicate,
'or,
'unknown,
'exit,
'labels))

Definition: exit not boolean error (e, sn) = mk error (list ('the,

                'exit,
                'specification,

e,

                'in,
                'scope,

sn,

                'is,
                'not,
                'a,
                'boolean-valued,
                'expression))
; *************************
;  Parse Tree Constructors
; *************************

Definition: mk opt condition handlers (x)

= mk tree ('opt condition handlers,

if x = nil then mk empty

else x endif)

Definition: mk signal stmt (c)

= mk tree ('signal statement,

list (mk reserved word ('signal), mk identifier (c)))

Definition: mk elif into if statement (x)

= mk tree ('if composition,

list (mk reserved word ('if), subtree (x, 'expression), mk reserved word ('then),

               subtree (x, 'opt internal statements),
               subtree (x, 'if composition else part),

mk opt condition handlers (nil),

mk reserved word ('end)))

Definition: component selectors (m) = if rule (m,

      prodn (tag ('value modifiers, 'm),
            tag ('component selectors, 's)))
then subtree (m, 'component selectors)

else nil endif

Definition: extend name selectors (ne, cs)

= if root (cs) ≠ 'component selectors then nil

elseif rule (ne,

          prodn (tag ('name expression, 'e),
                tag ('identifier, 'i)))
then mk tree ('name expression,

list (subtree (ne, 'identifier),

                mk tree ('selector list, cs)))

elseif rule (ne,

          prodn (tag ('name expression, 'e),
                list (tag ('identifier, 'i),
                   tag ('selector list, 'ss))))
then mk tree ('name expression,

list (subtree (ne, 'identifier),

                mk tree ('selector list,

list (subtree (ne, 'selector list), cs))))

else nil endif

Definition: mk name expression (e) = if root (e) = 'name expression then e

elseif rule (e,

          prodn (tag ('expression, 'e),
                tag ('modified primary value, 'm)))

then mk name expression (subtree (e, 'modified primary value)) elseif rule (e,

          prodn (tag ('modified primary value, 'm),
                tag ('primary value, 'p)))

then mk name expression (subtree (e, 'primary value)) elseif rule (e,

          prodn (tag ('modified primary value, 'm),
                list (tag ('modified primary value, 'm2),
                   tag ('value modifiers, 'vm))))

then extend name selectors (mk name expression (subtree (e,

                                                  'modified primary value)),

component selectors (subtree (e,

                                                 'value modifiers)))

elseif rule (e,

          prodn (tag ('primary value, 'p),
                tag ('identifier, 'on)))

then mk name expression (subtree (e, 'identifier)) elseif identifierp (e) then mk tree ('name expression, e) else nil endif

; ************************************************
;  Parse Tree Extraction and Recognizer Functions
; ************************************************

Definition: case labels (m) = if rule (m,

      prodn (tag ('case composition, 's),

list ('case,

                tag ('expression, 'e),
                tag ('case composition body, 'b),
                tag ('opt condition handlers, 'c),
                'end)))

then case labels (subtree (m, 'case composition body))

elseif rule (m, prodn (tag ('case composition body, 'b), 'empty))

then nil elseif rule (m,

          prodn (tag ('case composition body, 'b),

list ('else,

                   'colon,
                   tag ('opt internal statements, 'ss))))

then nil elseif rule (m,

          prodn (tag ('case composition body, 'b),

list ('is,

                   tag ('case labels, 'cs),
                   'colon,
                   tag ('opt internal statements, 'ss),
                   tag ('case composition body, 'b2))))

then append (case labels (subtree (m, 'case labels)),

case labels (subtree (m, 'case composition body)))

elseif rule (m,

          prodn (tag ('case labels, 'cs),
                tag ('pre computable label expression, 'e)))
then rcons (nil, subtree (m, 'pre computable label expression))

elseif rule (m,

          prodn (tag ('case labels, 'cs),

                list (tag ('case labels, 'cs2),
                   'comma,
                   tag ('pre computable label expression,

'e))))

then rcons (case labels (subtree (m, 'case labels)),

          subtree (m, 'pre computable label expression))

else nil endif

Definition: constant body (u) = if rule (u,

      prodn (tag ('constant declaration, 'd),
            list ('const,
                tag ('identifier, 'cn),
                'colon,
                tag ('type specification, 'rt),
                'colon equal,
                tag ('constant body, 'b))))

then subtree (u, 'constant body) else nil endif

Definition: id list (d) = if rule (d,

      prodn (tag ('identifier list, 'is),
            list (tag ('identifier list, 'is2),
                'comma,
                tag ('identifier, 'i))))

then rcons (id list (subtree (d, 'identifier list)),

id list (subtree (d, 'identifier)))

elseif rule (d,

          prodn (tag ('identifier list, 'is),
                tag ('identifier, 'i)))

then rcons (nil, id list (subtree (d, 'identifier))) elseif identifierp (d) then gname (d) else nil endif

Definition: actual cargs (m) = if rule (m,

      prodn (tag ('procedure statement, 's),
            list (tag ('identifier, 'pn),
                tag ('arg list, 'dp),
                tag ('opt actual condition parameters,

'cp)))) then actual cargs (subtree (m,

                       'opt actual condition parameters))

elseif rule (m,

          prodn (tag ('modified primary value, 'm),
                list (tag ('modified primary value, 'm2),
                   tag ('actual condition parameters, 'cp))))

then actual cargs (subtree (m, 'actual condition parameters)) elseif rule (m,

          prodn (tag ('opt actual condition parameters, 'cp),

'empty)) then nil

elseif rule (m,

          prodn (tag ('opt actual condition parameters, 'cp),
                tag ('actual condition parameters, 'cp2)))

then actual cargs (subtree (m, 'actual condition parameters)) elseif rule (m,

          prodn (tag ('actual condition parameters, 'cp),
                list ('unless,
                   'open paren,
                   tag ('opt group name, 'g),
                   tag ('identifier list, 'is),
                   'close paren)))

then id list (subtree (m, 'identifier list)) else nil endif

Definition: actual dargs (m) = if rule (m,

      prodn (tag ('procedure statement, 's),
            list (tag ('identifier, 'pn),
                tag ('arg list, 'dp),
                tag ('opt actual condition parameters,

'cp))))

then actual dargs (subtree (m, 'arg list)) elseif rule (m,

prodn (tag ('arg list, 'as),

                list ('open paren,
                   tag ('value list, 'vs),
                   'close paren)))

then actual dargs (subtree (m, 'value list)) elseif rule (m,

          prodn (tag ('value list, 'vs), tag ('expression, 'e)))

then rcons (nil, subtree (m, 'expression)) elseif rule (m,

          prodn (tag ('value list, 'vs),

list (tag ('value list, 'vs2),
'comma,
tag ('expression, 'e))))

then rcons (actual dargs (subtree (m, 'value list)),

subtree (m, 'expression))

else nil endif

Definition: formal cargs (u) = if rule (u,

prodn (tag ('procedure declaration, 'd),
list ('procedure,
tag ('identifier, 'pn),
tag ('external data objects, 'a),
tag ('opt external conditions, 'c),
'equal,
tag ('procedure body, 'b))))

then formal cargs (subtree (u, 'opt external conditions)) elseif rule (u,

prodn (tag ('function declaration, 'd),
list ('function,
tag ('identifier, 'fn),
tag ('opt external data objects, 'a),
'colon,
tag ('type specification, 'rt),
tag ('opt external conditions, 'c),
'equal,
tag ('procedure body, 'b))))

then formal cargs (subtree (u, 'opt external conditions)) elseif rule (u,

prodn (tag ('opt external conditions, 'c), 'empty))

then nil elseif rule (u,

prodn (tag ('opt external conditions, 'c),
list ('unless,
'open paren,
'cond,
tag ('identifier list, 'is),
'close paren)))

then id list (subtree (u, 'identifier list)) else nil endif

Definition: exit labels (e)

= if rule (e, prodn (tag ('opt exit specification, 'e), 'empty))

then nil elseif rule (e,

          prodn (tag ('opt exit specification, 'e),

list ('exit,

                   tag ('non validated specification expression,
                       'se),
                   'semi colon))) then nil

elseif rule (e,

          prodn (tag ('opt exit specification, 'e),

list ('exit,

                   tag ('conditional exit specification,
                       'c),
                   'semi colon)))
then exit labels (subtree (e, 'conditional exit specification))

elseif rule (e,

          prodn (tag ('conditional exit specification, 'c),

list ('case,

                   'open paren,
                   tag ('case exit body, 'e),
                   'close paren)))

then exit labels (subtree (e, 'case exit body)) elseif rule (e,

          prodn (tag ('case exit body, 'b), tag ('case exit, 'c)))

then exit labels (subtree (e, 'case exit)) elseif rule (e,

          prodn (tag ('case exit body, 'b),
                list (tag ('case exit body, 'b2),
                   'semi colon,
                   tag ('case exit, 'c))))

then append (exit labels (subtree (e, 'case exit body)),

exit labels (subtree (e, 'case exit)))

elseif rule (e,

prodn (tag ('case exit, 'ce),

list ('is,

                   tag ('case exit labels, 'l),
                   'colon,
                   tag ('non validated specification expression,

'e))))

then exit labels (subtree (e, 'case exit labels)) elseif rule (e,

          prodn (tag ('case exit labels, 'ls),
                list (tag ('case exit labels, 'ls2),
                   'comma,

                   tag ('exit label, 'l))))

then append (exit labels (subtree (e, 'case exit labels)),

exit labels (subtree (e, 'exit label)))

elseif rule (e,

          prodn (tag ('case exit labels, 'ls),
                tag ('exit label, 'l)))

then exit labels (subtree (e, 'exit label)) elseif rule (e, prodn (tag ('exit label, 'l), tag ('identifier, 'n))) then exit labels (subtree (e, 'identifier)) elseif rule (e, prodn (tag ('exit label, 'l), 'normal)) then list ('normal) elseif identifierp (e) then list (gname (e)) else nil endif

Definition: exit spec (u) = if rule (u,

      prodn (tag ('procedure declaration, 'd),
            list ('procedure,
                tag ('identifier, 'pn),
                tag ('external data objects, 'a),
                tag ('opt external conditions, 'c),
                'equal,
                tag ('procedure body, 'b))))

then exit spec (subtree (u, 'procedure body)) elseif rule (u,

          prodn (tag ('function declaration, 'd),
                list ('function,
                   tag ('identifier, 'fn),
                   tag ('opt external data objects, 'a),
                   'colon,
                   tag ('type specification, 'rt),
                   tag ('opt external conditions, 'c),
                   'equal,
                   tag ('procedure body, 'b))))

then exit spec (subtree (u, 'procedure body)) elseif rule (u, prodn (tag ('procedure body, 'b), 'pending)) then nil elseif rule (u,

          prodn (tag ('procedure body, 'b),
                list ('begin,
                   tag ('external operational specification,
                       'es),
                   tag ('opt internal environment, 'iv),

                   tag ('opt keep specification, 'k),
                   tag ('opt internal statements, 'st),
                   'end)))

then exit spec (subtree (u,

                     'external operational specification))

elseif rule (u,

          prodn (tag ('external operational specification,
                   's),
                list (tag ('opt entry specification, 'e),
                   tag ('opt exit specification, 'x))))
then subtree (u, 'opt exit specification)
elseif rule (u, prodn (tag ('opt exit specification, 'e), 'empty))

then u elseif rule (u,

          prodn (tag ('opt exit specification, 'e),

list ('exit,

                   tag ('non validated specification expression,
                       'se),
                   'semi colon))) then u

elseif rule (u,

          prodn (tag ('opt exit specification, 'e),

list ('exit,

                   tag ('conditional exit specification,
                       'c),
                   'semi colon))) then u

else nil endif

Definition: handler (m, c)

= if rule (m, prodn (tag ('opt condition handlers, 'c), 'empty))

then nil elseif rule (m,

          prodn (tag ('opt condition handlers, 'c),
                list ('when, tag ('opt handler list, 'hs))))

then handler (subtree (m, 'opt handler list), c) elseif rule (m, prodn (tag ('opt handler list, 'hs), 'empty)) then nil elseif rule (m,

          prodn (tag ('opt handler list, 'hs),
                tag ('handler list, 'hs2)))

then handler (subtree (m, 'handler list), c) elseif rule (m, prodn (tag ('handler list, 'hs), tag ('handler, 'h))) then handler (subtree (m, 'handler), c) elseif rule (m,

          prodn (tag ('handler list, 'hs),
                list (tag ('handler list, 'hs2),
                   tag ('handler, 'h))))

then let r be handler (subtree (m, 'handler list), c)

in

if r = nil then handler (subtree (m, 'handler), c) else r endif endlet

elseif rule (m,

prodn (tag ('handler, 'h), list ('is,

                   tag ('identifier list, 'cs),
                   'colon,
                   tag ('opt internal statements, 's))))

then if c ∈ id list (subtree (m, 'identifier list))

     then subtree (m, 'opt internal statements)

else nil endif else nil endif

Definition: handler labels (m)

= if rule (m, prodn (tag ('opt condition handlers, 'c), 'empty))

then nil elseif rule (m,

          prodn (tag ('opt condition handlers, 'c),
                list ('when, tag ('opt handler list, 'hs))))

then handler labels (subtree (m, 'opt handler list)) elseif rule (m, prodn (tag ('opt handler list, 'hs), 'empty)) then nil elseif rule (m,

          prodn (tag ('opt handler list, 'hs),
                tag ('handler list, 'hs2)))

then handler labels (subtree (m, 'handler list)) elseif rule (m, prodn (tag ('handler list, 'hs), tag ('handler, 'h))) then handler labels (subtree (m, 'handler)) elseif rule (m,

          prodn (tag ('handler list, 'hs),
                list (tag ('handler list, 'hs2),
                   tag ('handler, 'h))))

then append (handler labels (subtree (m, 'handler list)),

handler labels (subtree (m, 'handler)))

elseif rule (m,

prodn (tag ('handler, 'h), list ('is,

                   tag ('identifier list, 'cs),

   'colon,
   tag ('opt internal statements, 's))))

then id list (subtree (m, 'identifier list)) else nil endif

Definition: internal initial value exp (m) = if rule (m,

prodn (tag ('internal data or condition objects, 'iv),
list (tag ('access specification, 'a),
tag ('identifier list, 'is),
'colon,
tag ('type specification, 'ts),
tag ('opt internal initial value, 'v),
'semi colon)))

then internal initial value exp (subtree (m,

                  'opt internal initial value))

elseif rule (m,

prodn (tag ('opt internal initial value, 'v),

'empty)) then nil

elseif rule (m,

prodn (tag ('opt internal initial value, 'v),
list ('colon equal, tag ('expression, 'e))))

then subtree (m, 'expression) else nil endif

Definition: keep spec (u) = if rule (u,

prodn (tag ('procedure declaration, 'd),
list ('procedure,
tag ('identifier, 'pn),
tag ('external data objects, 'a),
tag ('opt external conditions, 'c),
'equal,
tag ('procedure body, 'b))))

then keep spec (subtree (u, 'procedure body)) elseif rule (u,

prodn (tag ('function declaration, 'd),
list ('function,
   tag ('identifier, 'fn),
   tag ('opt external data objects, 'a),
   'colon,
   tag ('type specification, 'rt),

tag ('opt external conditions, 'c),
'equal,
tag ('procedure body, 'b))))

then keep spec (subtree (u, 'procedure body)) elseif rule (u,

prodn (tag ('procedure body, 'b),
list ('begin,
tag ('external operational specification,
    'es),
tag ('opt internal environment, 'iv),
tag ('opt keep specification, 'k),
tag ('opt internal statements, 'st),
'end)))

then keep spec (subtree (u, 'opt keep specification))

elseif rule (u, prodn (tag ('opt keep specification, 'k), 'empty))

then mk true expression elseif rule (u,

prodn (tag ('opt keep specification, 'k),

list ('keep,

tag ('non validated specification expression,
    'se),
'semi colon)))

then keep spec (subtree (u,

  'non validated specification expression))

elseif rule (u,

prodn (tag ('non validated specification expression,
'se),
list ('open paren,
tag ('proof directive, 'd),
tag ('expression, 'e),
'close paren)))

∨ rule (u,

prodn (tag ('non validated specification expression,
   'se),
list (tag ('proof directive, 'd),
   tag ('expression, 'e))))

∨ rule (u,

prodn (tag ('non validated specification expression,
   'se),
tag ('expression, 'e)))

then subtree (u, 'expression) else nil endif

Definition: if statement else part (s) = if rule (s,

      prodn (tag ('if composition, 's),

list ('if,

                tag ('expression, 'b),
                'then,
                tag ('opt internal statements, 'ss),
                tag ('if composition else part, 'ep),
                tag ('opt condition handlers, 'cs),
                'end)))

then if statement else part (subtree (s,

                               'if composition else part))

elseif rule (s,

          prodn (tag ('if composition else part, 'ep),

'empty)) then nil

elseif rule (s,

          prodn (tag ('if composition else part, 'ep),

list ('else,

                   tag ('opt internal statements, 'ss))))
then subtree (s, 'opt internal statements)

elseif rule (s,

          prodn (tag ('if composition else part, 'ep),

list ('elif,

                   tag ('expression, 'b),
                   'then,
                   tag ('opt internal statements, 'ss),
                   tag ('if composition else part, 'ep2))))

then mk elif into if statement (s) else nil endif

Definition: new name arg (m) = if rule (m,

      prodn (tag ('move statement, 's),

list ('move,

                tag ('removable component, 'c),
                tag ('component destination, 'd))))

then new name arg (subtree (m, 'component destination)) elseif rule (m,

          prodn (tag ('component destination, 'd),
                tag ('new dynamic variable component, 'dc)))
then new name arg (subtree (m, 'new dynamic variable component))

elseif rule (m,

          prodn (tag ('component destination, 'd),

list ('to, tag ('name expression, 'ne))))
then subtree (m, 'name expression)

elseif rule (m,

prodn (tag ('new statement, 's),

list ('new,

tag ('expression, 'e),
tag ('new dynamic variable component,

'dc))))

then new name arg (subtree (m, 'new dynamic variable component))

elseif rule (m,

prodn (tag ('new dynamic variable component, 'dc),
list ('into, tag ('name expression, 'ne))))

∨ rule (m,

prodn (tag ('new dynamic variable component,
'dc),

list ('into,

'set,
tag ('name expression, 'ne))))

∨ rule (m,

prodn (tag ('new dynamic variable component,
'dc),
list ('before,
tag ('name expression, 'ne))))

∨ rule (m,

prodn (tag ('new dynamic variable component,
'dc),
list ('before,
'seq,
tag ('name expression, 'ne))))

∨ rule (m,

prodn (tag ('new dynamic variable component,
'dc),
list ('behind,
tag ('name expression, 'ne))))

∨ rule (m,

prodn (tag ('new dynamic variable component,
'dc),
list ('behind,
'seq,
tag ('name expression, 'ne))))
then subtree (m, 'name expression)

else nil endif

Definition: remove exp arg (m) = if rule (m,

      prodn (tag ('move statement, 's),

list ('move,

                tag ('removable component, 'c),
                tag ('component destination, 'd))))

then remove exp arg (subtree (m, 'removable component)) elseif rule (m,

          prodn (tag ('remove statement, 's),
                list ('remove, tag ('removable component, 'c))))

then remove exp arg (subtree (m, 'removable component)) elseif rule (m,

          prodn (tag ('removable component, 'c),
                list ('element,
                   tag ('expression, 'e),
                   'from,
                   'set,
                   tag ('name expression, 'ne))))

then subtree (m, 'expression) elseif rule (m,

          prodn (tag ('removable component, 'c),
                tag ('name expression, 'e))) then nil

else nil endif

Definition: remove name arg (m) = if rule (m,

      prodn (tag ('move statement, 's),

list ('move,

                tag ('removable component, 'c),
                tag ('component destination, 'd))))

then remove name arg (subtree (m, 'removable component)) elseif rule (m,

          prodn (tag ('remove statement, 's),
                list ('remove, tag ('removable component, 'c))))

then remove name arg (subtree (m, 'removable component)) elseif rule (m,

          prodn (tag ('removable component, 'c),
                list ('element,
                   tag ('expression, 'e),
                   'from,
                   'set,
                   tag ('name expression, 'ne))))
then subtree (m, 'name expression)

elseif rule (m,

             prodn (tag ('removable component, 'c),
                   tag ('name expression, 'e)))
    then subtree (m, 'name expression)

else nil endif

Definition: procedure body (d) = if rule (d,

          prodn (tag ('procedure declaration, 'd),
                list ('procedure,
                   tag ('identifier, 'pn),
                   tag ('external data objects, 'a),
                   tag ('opt external conditions, 'c),
                   'equal,
                   tag ('procedure body, 'b))))

∨ rule (d,

             prodn (tag ('function declaration, 'd),
                   list ('function,
                       tag ('identifier, 'fn),
                       tag ('opt external data objects, 'a),
                       'colon,
                       tag ('type specification, 'rt),
                       tag ('opt external conditions, 'c),
                       'equal,
                       tag ('procedure body, 'b))))

then subtree (d, 'procedure body)

else nil endif

; ****************************************************************************
;
;                                 THE STATE
;
; ****************************************************************************
; The state is a marked object <mark , map>.  The mark is either NIL or 'IND,
; which indicates an indeterminate state.  The map is a name-value mapping.
; It maps variables (and constants) to their (marked typed) values.  In
; addition, it contains the special components:
;
;     entry - the (marked typed) value resulting from evaluation of the
;             entry specification on the initial state
;     exit - the (marked typed) value resulting from evaluation of the
;            exit specification on the final state

;     keep - the (marked typed) value that is the conjunction of results
;            from all evaluations of the keep specification
;     assert - the (marked typed) value that is the conjunction of results
;              from all evaluations of assert specifications
;     keep~ - the parse tree for the keep specification
;     cond~ - the currently active condition
;     result~ - the (marked typed) value resulting from expression evaluation
;     var - a name-value mapping from variable names, arguments and locals,
;           to local|formal
;     const - a name-value mapping from constant names, arguments and locals,
;             to local|formal
;     cond - a name-value mapping from condition names, arguments and locals,
;            to local|formal

Definition: default state = marked (nil,

list (cons ('entry, gtrue), cons ('exit, gtrue), cons ('keep, gtrue), cons ('assert, gtrue), cons ('keep~, mk true expression),

              cons ('cond~, 'normal),

cons ('result~, gizero),

cons ('var, nil), cons ('const, nil), cons ('cond,

                   '((routineerror . formal)
                     (spaceerror . formal)))))
; =========================================
;  Extraction of Components from the State
; =========================================

Definition: map (s) = object (s)

Definition: state componentp (k, s) = in map (map (s), k)

Definition: state component (k, s) = mapped value (map (s), k)

Definition: entry (s) = mapped value (map (s), 'entry)

Definition: exit (s) = mapped value (map (s), 'exit)

Definition: keep (s) = mapped value (map (s), 'keep) Definition: assert (s) = mapped value (map (s), 'assert) Definition: keep˜ (s) = mapped value (map (s), 'keep~) Definition: cond˜ (s) = mapped value (map (s), 'cond~) Definition: condition normal (s) = (cond˜ (s) = 'normal) Definition: condition non normal (s) = (¬ condition normal (s)) Definition: normal state (s) = (determinate (s) ∧ condition normal (s)) Definition: result˜ (s) = mapped value (map (s), 'result~) Definition: result˜ list (ss) = if ss ≃ nil then nil

else cons (result˜ (car (ss)), result˜ list (cdr (ss))) endif Definition: var (s) = mapped value (map (s), 'var) Definition: const (s) = mapped value (map (s), 'const) Definition: cond+ (s) = mapped value (map (s), 'cond) Definition: variablep (id, s) = (state componentp (id, s) ∧ in map (var (s), id)) Definition: conditionp (id, s) = in map (cond+ (s), id) Definition: all conditionsp (ids, s) = if ids ≃ nil then t

else conditionp (car (ids), s) ∧ all conditionsp (cdr (ids), s) endif Definition: type of (n, s) = type (state component (n, s)) Definition: mode (td) = root (td) Definition: locals (cs) = if cs ≃ nil then nil

elseif cdar (cs) = 'local then cons (car (cs), locals (cdr (cs))) else locals (cdr (cs)) endif Definition: local vars (s) = locals (var (s))

Definition: local consts (s) = locals (const (s))

Definition: local conds (s) = locals (cond+ (s))

; =================================
;  Setting Components of the State
; =================================

Definition: mark state indeterminate (s) = marked ('ind, map (s))

Definition: store value (k, v, s) = marked (mark (s), add to map (map (s), k, v))

Definition: set condition (s, c) = store value ('cond~, c, s)

Definition: store result˜ (v, s) = if determinate (v) then store value ('result~, v, s)

else set condition (s, 'routineerror) endif

Definition: all determinate (vs) = if vs ≃ nil then vs = nil

else determinate (car (vs)) ∧ all determinate (cdr (vs)) endif

Definition: reset leave to normal (s) = if cond˜ (s) = 'leave then set condition (s, 'normal)

else s endif

Definition: record assertion (a, s) = store value ('assert, gand (assert (s), a), s)

Definition: store cond (id, sc, s) = store value ('cond, cons (cons (id, sc), cond+ (s)), s)

Definition: note conds (cs, sc, s) = if cs ≃ nil then s

else store cond (car (cs), sc, note conds (cdr (cs), sc, s)) endif

Definition: store const (id, v, sc, s) = store value ('const, cons (cons (id, sc), const (s)), store value (id, v, s))

Definition: store var (id, v, sc, s) = store value ('var, cons (cons (id, sc), var (s)), store value (id, v, s))

; ====================================
;  Deleting Components from the State
; ====================================

Definition: deallocate (k, s) = marked (mark (s), remove (assoc (k, map (s)), map (s)))

Definition: deallocate vars (vs, s) = if vs ≃ nil then s

else deallocate vars (cdr (vs),

deallocate (caar (vs),

store value ('var,

remove (car (vs),

var (s)), s))) endif

Definition: deallocate consts (cs, s) = if cs ≃ nil then s

else deallocate consts (cdr (cs),

deallocate (caar (cs),

store value ('const,

remove (car (cs),

const (s)), s))) endif

Definition: deallocate conds (cs, s) = if cs ≃ nil then s

else deallocate conds (cdr (cs),

store value ('cond, remove (car (cs), cond+ (s)), s)) endif

; ================
;  State Equality
; ================

Definition: scomp equal (k, v1 , v2 ) = if k ∈ '(var const cond) then set equal (v1 , v2 )

elseif k = 'cond~ then v1 = v2

elseif k = 'keep~ then tree equal (v1 , v2 )

else gtruep (gequal (v1 , v2 )) ∧ (type (v1 ) = type (v2 )) endif

Definition: ssubmap (m1 , m2 ) = if m1 ≃ nil then t

else in map (m2 , caar (m1 ))

∧ scomp equal (caar (m1 ), cdar (m1 ), mapped value (m2 , caar (m1 )))

∧ ssubmap (cdr (m1 ), m2 ) endif

Definition: smap equal (m1 , m2 ) = (ssubmap (m1 , m2 ) ∧ ssubmap (m2 , m1 ))

Definition: sequal (s1 , s2 ) = if s1 = s2 then t

else (mark (s1 ) = mark (s2 )) ∧ smap equal (map (s1 ), map (s2 )) endif

; ********************
;  Constraint Support
; ********************
;; The following was a DEFN-SK+ form, but the three events that
;; would presumably be generated after the DEFN-SK have been
;; inserted below in capital letters.

Definition: implementation constrained (s1 , s0 ) ↔ ∀ k ((k ≠ 'cond~)

→ (mapped value (map (s1 ), k) = mapped value (map (s0 ), k)))

Event: Enable implementation constrained; name this event ‘implementation constrainedoff’.

Theorem: implementation constrained-suff ((k (s0 , s1 ) ≠ 'cond~) → (mapped value (map (s1 ), k (s0 , s1 )) = mapped value (map (s0 ), k (s0 , s1 )))) → implementation constrained (s1 , s0 )

Theorem: implementation constrained-necc (¬ ((k ≠ 'cond~)

→ (mapped value (map (s1 ), k) = mapped value (map (s0 ), k)))) → (¬ implementation constrained (s1 , s0 ))

Definition: state check (ss, s0 ) = if (ss ≃ nil) ∨ (¬ normal state (s0 )) then s0

elseif normal state (car (ss)) then state check (cdr (ss), s0 )

else set condition (marked (mark (car (ss)), map (s0 )), cond˜ (car (ss))) endif

Event: Disable sequal.

Event: Disable store value.

Event: Disable cond˜.

Event: Enable determinate.

; ****************
;  Literal Values
; ****************

Conservative Axiom: p gfalse intro let s1 be p gfalse (s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gfalse, s0 ))

∧ determinate (gfalse))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gfalse.

Definition: gpf false (s0 ) = if normal state (s0 ) then p gfalse (s0 )

else s0 endif Conservative Axiom: p gtrue intro let s1 be p gtrue (s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gtrue, s0 ))

∧ determinate (gtrue))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

             ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gtrue.

Definition: gpf true (s0 ) = if normal state (s0 ) then p gtrue (s0 )

else s0 endif

Conservative Axiom: p minteger intro let s1 be p minteger (e, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, minteger (e), s0 ))

∧ determinate (minteger (e)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

             ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p minteger.

Definition: gpf minteger (e, s) = if normal state (s) then p minteger (e, s)

else s endif

Conservative Axiom: p gchar intro let s1 be p gchar (e, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gchar (e), s0 ))

∧ determinate (gchar (e)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

             ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gchar.

Definition: gpf gchar (e, s) = if normal state (s) then p gchar (e, s)

else s endif

Conservative Axiom: p gstring seq intro let s1 be p gstring seq (e, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gstring seq (e), s0 ))

∧ determinate (gstring seq (e)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gstring seq.

Definition: gpf gstring seq (e, s) = if normal state (s) then p gstring seq (e, s)

else s endif

; ******************
;  Gypsy Operations
; ******************
; ---------------------
;  Component Selection
; ---------------------

Event: Disable array get.

Conservative Axiom: p array get intro let s1 be p array get (a, i, td, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, array get (a, i, td), s0 ))

∧ determinate (array get (a, i, td)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p array get.

Definition: gpf array get (sa, si, s0 ) = let r be state check (list (sa, si), s0 )

in

if normal state (r)

then p array get (result˜ (sa), result˜ (si), type (result˜ (sa)), s0 ) else r endif endlet

Event: Disable mapping get.

Conservative Axiom: p mapping get intro let s1 be p mapping get (m, d, td, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, mapping get (m, d, td), s0 ))

∧ determinate (mapping get (m, d, td)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p mapping get.

Definition: gpf mapping get (sm, sd, s0 ) = let r be state check (list (sm, sd), s0 )

in

if normal state (r)

then p mapping get (result˜ (sm), result˜ (sd), type (result˜ (sm)), s0 )

else r endif endlet

Event: Disable record get.

Conservative Axiom: p record get intro let s1 be p record get (r, fn, td, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, record get (r, fn, td), s0 ))

∧ determinate (record get (r, fn, td))))

∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p record get.

Definition: gpf record get (sr, sfn, s0 ) = let r be state check (list (sr, sfn), s0 )

in

if normal state (r)

then p record get (result˜ (sr), result˜ (sfn), type (result˜ (sr)), s0 )

else r endif endlet

Event: Disable sequence get.

Conservative Axiom: p sequence get intro let s1 be p sequence get (s, i, td, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, sequence get (s, i, td), s0 ))

∧ determinate (sequence get (s, i, td)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p sequence get.

Definition: gpf sequence get (ss, si, s0 ) = let r be state check (list (ss, si), s0 )

in

if normal state (r)

then p sequence get (result˜ (ss), result˜ (si), type (result˜ (ss)), s0 )

else r endif endlet Event: Disable state check. Event: Disable normal state. Event: Disable mode. Event: Disable type. Event: Disable result˜. Event: Disable gpf array get. Event: Disable gpf record get. Event: Disable gpf mapping get. Event: Disable gpf sequence get. Event: Disable store result˜. Event: Disable not selectable error. Event: Disable default value. Event: Disable integer desc. Event: Disable *1*integer desc.

;; >> It might be better to just constrain this and forget the four defn's
;; above.

Definition: gpf select op (sv, ss, s0 ) = let r be state check (cons (sv, ss), s0 )

in

if ¬ normal state (r) then r elseif ss ≃ nil then sv else case on mode (type (result˜ (sv))):

case = array

then gpf select op (gpf array get (sv, car (ss), s0 ), cdr (ss), s0 )

case = record

then gpf select op (gpf record get (sv, car (ss), s0 ), cdr (ss), s0 )

case = mapping

then gpf select op (gpf mapping get (sv, car (ss), s0 ), cdr (ss), s0 )

case = sequence

then gpf select op (gpf sequence get (sv, car (ss), s0 ), cdr (ss), s0 )

otherwise store result˜ (marked (not selectable error (result˜ (sv)),

default value (integer desc)), s0 ) endcase endif endlet

; -----------------------
;  Subsequence Selection
; -----------------------

Event: Disable subsequence get.

Conservative Axiom: p subsequence get intro let s1 be p subsequence get (s, lo, hi, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 ,

store value ('result~, subsequence get (s, lo, hi), s0 )) ∧ determinate (subsequence get (s, lo, hi))))

∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p subsequence get.

Definition: gpf subsequence get (ss, slo, shi, s0 ) = let r be state check (list (ss, slo, shi), s0 )

in

if normal state (r)

then p subsequence get (result˜ (ss), result˜ (slo), result˜ (shi), s0 )

else r endif endlet

; ------------------
;  Value Alteration
; ------------------

Event: Disable array put.

Conservative Axiom: p array put intro let s1 be p array put (a, i, v, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, array put (a, i, v), s0 ))

∧ determinate (array put (a, i, v)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p array put.

Definition: gpf array put (sa, si, sv, s0 ) = let r be state check (list (sa, si, sv), s0 )

in

if normal state (r)

then p array put (result˜ (sa), result˜ (si), result˜ (sv), s0 ) else r endif endlet

Event: Disable record put.

Conservative Axiom: p record put intro let s1 be p record put (r, fn, v, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal))

→ (sequal (s1 , store value ('result~, record put (r, fn, v), s0 ))

∧ determinate (record put (r, fn, v)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p record put.

Definition: gpf record put (sr, sfn, sv, s0 ) = let r be state check (list (sr, sfn, sv), s0 )

in

if normal state (r)

then p record put (result˜ (sr), result˜ (sfn), result˜ (sv), s0 )

else r endif endlet

Event: Disable mapping put.

Conservative Axiom: p mapping put intro let s1 be p mapping put (m, d, v, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, mapping put (m, d, v), s0 ))

∧ determinate (mapping put (m, d, v)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p mapping put.

Definition: gpf mapping put (sm, sd, sv, s0 ) = let r be state check (list (sm, sd, sv), s0 )

in

if normal state (r)

then p mapping put (result˜ (sm), result˜ (sd), result˜ (sv), s0 ) else r endif endlet

Event: Disable sequence put.

Conservative Axiom: p sequence put intro let s1 be p sequence put (s, i, v, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, sequence put (s, i, v), s0 ))

∧ determinate (sequence put (s, i, v)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

          ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p sequence put.

Definition: gpf sequence put (ss, si, sv, s0 ) = let r be state check (list (ss, si, sv), s0 )

in if normal state (r) then p sequence put (result˜ (ss), result˜ (si), result˜ (sv), s0 ) else r endif endlet

Definition: gpf put op (sbv, ss, sv, s0 ) = let r be state check (cons (sbv, rcons (ss, sv)), s0 )

in if ¬ normal state (r) then r elseif ss ≃ nil then store result˜ (result˜ (sv), s0 ) else case on mode (type (result˜ (sbv))):

case = array

then gpf array put (sbv, car (ss), gpf put op (gpf array get (sbv,

car (ss), s0 ),

cdr (ss), sv, s0 ),

s0 )

case = record

then gpf record put (sbv, car (ss), gpf put op (gpf record get (sbv,

car (ss), s0 ),

cdr (ss), sv, s0 ),

s0 )

case = mapping

then gpf mapping put (sbv, car (ss), gpf put op (gpf mapping get (sbv,

car (ss), s0 ),

cdr (ss), sv, s0 ),

s0 )

case = sequence

then gpf sequence put (sbv, car (ss), gpf put op (gpf sequence get (sbv,

car (ss), s0 ),

cdr (ss), sv, s0 ),

s0 )

otherwise store result˜ (marked (component assign error (result˜ (sbv)),

default value (integer desc)), s0 ) endcase endif endlet

Event: Disable gmapomit.

Conservative Axiom: p gmapomit intro let s1 be p gmapomit (m, i, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gmapomit (m, i), s0 ))

∧ determinate (gmapomit (m, i)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gmapomit.

Definition: gpf gmapomit (sm, si, s0 ) = let r be state check (list (sm, si), s0 )

in if normal state (r) then p gmapomit (result˜ (sm), result˜ (si), s0 ) else r endif endlet

Event: Disable gseqomit.

Conservative Axiom: p gseqomit intro let s1 be p gseqomit (s, i, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gseqomit (s, i), s0 ))

∧ determinate (gseqomit (s, i)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gseqomit.

Definition: gpf gseqomit (ss, si, s0 ) = let r be state check (list (ss, si), s0 )

in

if normal state (r) then p gseqomit (result˜ (ss), result˜ (si), s0 ) else r endif endlet

Event: Disable gmap insert.

Conservative Axiom: p gmap insert intro let s1 be p gmap insert (m, d, v, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gmap insert (m, d, v), s0 ))

∧ determinate (gmap insert (m, d, v)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gmap insert.

Definition: gpf gmap insert (sm, sd, sv, s0 ) = let r be state check (list (sm, sd, sv), s0 )

in if normal state (r) then p gmap insert (result˜ (sm), result˜ (sd), result˜ (sv), s0 ) else r endif endlet

Event: Disable gseq insert before.

Conservative Axiom: p gseq insert before intro let s1 be p gseq insert before (s, i, v, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 ,

store value ('result~, gseq insert before (s, i, v), s0 )) ∧ determinate (gseq insert before (s, i, v))))

∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gseq insert before.

Definition: gpf gseq insert before (ss, si, sv, s0 ) = let r be state check (list (ss, si, sv), s0 )

in

if normal state (r)

then p gseq insert before (result˜ (ss), result˜ (si), result˜ (sv), s0 )

else r endif endlet

Event: Disable gseq insert behind.

Conservative Axiom: p gseq insert behind intro let s1 be p gseq insert behind (s, i, v, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 ,

store value ('result~, gseq insert behind (s, i, v), s0 )) ∧ determinate (gseq insert behind (s, i, v))))

∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gseq insert behind.

Definition: gpf gseq insert behind (ss, si, sv, s0 ) = let r be state check (list (ss, si, sv), s0 )

in

if normal state (r)

then p gseq insert behind (result˜ (ss), result˜ (si), result˜ (sv), s0 )

else r endif endlet

; ---------------------------
;  Sequence/Set Constructors
; ---------------------------

Event: Disable gseq.

Conservative Axiom: p gseq intro let s1 be p gseq (es, td, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gseq (es, td), s0 ))

∧ determinate (gseq (es, td)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gseq.

Definition: gpf gseq (ses, td, s0 ) = let r be state check (ses, s0 )

in

if normal state (r) then p gseq (result˜ list (ses), td, s0 )

else r endif endlet

Event: Disable gset.

Conservative Axiom: p gset intro let s1 be p gset (es, td, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gset (es, td), s0 ))

∧ determinate (gset (es, td)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gset.

Definition: gpf gset (ses, td, s0 ) = let r be state check (ses, s0 )

in

if normal state (r) then p gset (result˜ list (ses), td, s0 )

else r endif endlet

Event: Disable grange elements.

Conservative Axiom: p grange elements intro let s1 be p grange elements (lo, hi, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, grange elements (lo, hi), s0 ))

∧ all determinate (grange elements (lo, hi)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p grange elements.

Definition: range element state list2 (es, s) = if es ≃ nil then nil

else cons (store result˜ (car (es), s), range element state list2 (cdr (es), s)) endif

Definition: range element state list (s) = if normal state (s) then range element state list2 (result˜ (s), s)

else list (s) endif Definition: gpf grange elements (slo, shi, s0 ) = let r be state check (list (slo, shi), s0 )

in

if normal state (r)

then range element state list (p grange elements (result˜ (slo), result˜ (shi), s0 ))

else r endif endlet

Definition: gpf gset or seq (m, ses, td, s0 ) = if rule (m, prodn (tag ('set or seq mark, 'm), list ('set, 'colon)))

then gpf gset (ses, td, s0 )

elseif rule (m,

             prodn (tag ('set or seq mark, 'm), list ('seq, 'colon)))

then gpf gseq (ses, td, s0 ) else gpf gseq (ses, td, s0 ) endif

; -----------------
;  Unary Operators
; -----------------

Event: Disable gminus.

Conservative Axiom: p gminus intro let s1 be p gminus (v, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gminus (v), s0 ))

∧ determinate (gminus (v)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gminus.

Definition: gpf gminus (sv, s0 ) = let r be state check (list (sv), s0 )

in

if normal state (r) then p gminus (result˜ (sv), s0 )

else r endif endlet Event: Disable gnot.

Conservative Axiom: p gnot intro let s1 be p gnot (v, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gnot (v), s0 ))

∧ determinate (gnot (v)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gnot.

Definition: gpf gnot (sv, s0 ) = let r be state check (list (sv), s0 )

in

if normal state (r) then p gnot (result˜ (sv), s0 )

else r endif endlet

Definition: gpf apply unary op (op, sv, s0 ) = if rule (op, prodn (tag ('unary operator, 'op), 'minus))

then gpf gminus (sv, s0 )

elseif rule (op, prodn (tag ('unary operator, 'op), 'not)) then gpf gnot (sv, s0 ) else mark state indeterminate (s0 ) endif

; ------------------
;  Binary Operators
; ------------------

Event: Disable gequal.

Conservative Axiom: p gequal intro let s1 be p gequal (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gequal (v1 , v2 ), s0 ))

∧ determinate (gequal (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gequal.

Definition: gpf gequal (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p gequal (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable gne.

Conservative Axiom: p gne intro let s1 be p gne (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gne (v1 , v2 ), s0 ))

∧ determinate (gne (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gne.

Definition: gpf gne (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p gne (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable glt.

Conservative Axiom: p glt intro let s1 be p glt (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, glt (v1 , v2 ), s0 ))

∧ determinate (glt (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

Simultaneously, we introduce the new function symbol p glt.

Definition: gpf glt (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p glt (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable gor.

Conservative Axiom: p gor intro let s1 be p gor (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gor (v1 , v2 ), s0 ))

∧ determinate (gor (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gor.

Definition: gpf gor (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p gor (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable gle.

Conservative Axiom: p gle intro let s1 be p gle (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gle (v1 , v2 ), s0 ))

∧ determinate (gle (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

Simultaneously, we introduce the new function symbol p gle.

Definition: gpf gle (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p gle (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable ggt.

Conservative Axiom: p ggt intro let s1 be p ggt (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, ggt (v1 , v2 ), s0 ))

∧ determinate (ggt (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p ggt.

Definition: gpf ggt (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p ggt (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable gge.

Conservative Axiom: p gge intro let s1 be p gge (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gge (v1 , v2 ), s0 ))

∧ determinate (gge (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

Simultaneously, we introduce the new function symbol p gge.

Definition: gpf gge (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p gge (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable gand.

Conservative Axiom: p gand intro let s1 be p gand (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gand (v1 , v2 ), s0 ))

∧ determinate (gand (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gand.

Definition: gpf gand (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p gand (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable gimp.

Conservative Axiom: p gimp intro let s1 be p gimp (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gimp (v1 , v2 ), s0 ))

∧ determinate (gimp (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

Simultaneously, we introduce the new function symbol p gimp.

Definition: gpf gimp (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p gimp (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable giff.

Conservative Axiom: p giff intro let s1 be p giff (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, giff (v1 , v2 ), s0 ))

∧ determinate (giff (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p giff .

Definition: gpf giff (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p giff (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable gpower.

Conservative Axiom: p gpower intro let s1 be p gpower (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gpower (v1 , v2 ), s0 ))

∧ determinate (gpower (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

Simultaneously, we introduce the new function symbol p gpower.

Definition: gpf gpower (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p gpower (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable gtimes.

Conservative Axiom: p gtimes intro let s1 be p gtimes (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gtimes (v1 , v2 ), s0 ))

∧ determinate (gtimes (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gtimes.

Definition: gpf gtimes (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p gtimes (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable gquotient.

Conservative Axiom: p gquotient intro let s1 be p gquotient (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gquotient (v1 , v2 ), s0 ))

∧ determinate (gquotient (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

Simultaneously, we introduce the new function symbol p gquotient.

Definition: gpf gquotient (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r)

then p gquotient (result˜ (sv1 ), result˜ (sv2 ), s0 )

else r endif endlet

Event: Disable gdiv.

Conservative Axiom: p gdiv intro let s1 be p gdiv (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gdiv (v1 , v2 ), s0 ))

∧ determinate (gdiv (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gdiv.

Definition: gpf gdiv (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p gdiv (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable gmod.

Conservative Axiom: p gmod intro let s1 be p gmod (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gmod (v1 , v2 ), s0 ))

∧ determinate (gmod (v1 , v2 ))))

∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gmod.

Definition: gpf gmod (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p gmod (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable gplus.

Conservative Axiom: p gplus intro let s1 be p gplus (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gplus (v1 , v2 ), s0 ))

∧ determinate (gplus (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gplus.

Definition: gpf gplus (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p gplus (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable gsubtract.

Conservative Axiom: p gsubtract intro let s1 be p gsubtract (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gsubtract (v1 , v2 ), s0 ))

∧ determinate (gsubtract (v1 , v2 ))))

∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gsubtract.

Definition: gpf gsubtract (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r)

then p gsubtract (result˜ (sv1 ), result˜ (sv2 ), s0 )

else r endif endlet

Event: Disable gin.

Conservative Axiom: p gin intro let s1 be p gin (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gin (v1 , v2 ), s0 ))

∧ determinate (gin (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gin.

Definition: gpf gin (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p gin (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable gunion.

Conservative Axiom: p gunion intro let s1 be p gunion (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gunion (v1 , v2 ), s0 ))

∧ determinate (gunion (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gunion.

Definition: gpf gunion (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p gunion (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable gadjoin.

Conservative Axiom: p gadjoin intro let s1 be p gadjoin (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gadjoin (v1 , v2 ), s0 ))

∧ determinate (gadjoin (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gadjoin.

Definition: gpf gadjoin (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r)

then p gadjoin (result˜ (sv1 ), result˜ (sv2 ), s0 )

else r endif endlet

Event: Disable gomit.

Conservative Axiom: p gomit intro let s1 be p gomit (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal))

→ (sequal (s1 , store value ('result~, gomit (v1 , v2 ), s0 ))

∧ determinate (gomit (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gomit.

Definition: gpf gomit (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p gomit (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable gsub.

Conservative Axiom: p gsub intro let s1 be p gsub (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gsub (v1 , v2 ), s0 ))

∧ determinate (gsub (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gsub.

Definition: gpf gsub (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p gsub (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable gintersect.

Conservative Axiom: p gintersect intro let s1 be p gintersect (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal))

→ (sequal (s1 , store value ('result~, gintersect (v1 , v2 ), s0 ))

∧ determinate (gintersect (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gintersect.

Definition: gpf gintersect (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r)

then p gintersect (result˜ (sv1 ), result˜ (sv2 ), s0 )

else r endif endlet

Event: Disable gdifference.

Conservative Axiom: p gdifference intro let s1 be p gdifference (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gdifference (v1 , v2 ), s0 ))

∧ determinate (gdifference (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gdifference.

Definition: gpf gdifference (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r)

then p gdifference (result˜ (sv1 ), result˜ (sv2 ), s0 )

else r endif endlet

Event: Disable gappend.

Conservative Axiom: p gappend intro let s1 be p gappend (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gappend (v1 , v2 ), s0 ))

∧ determinate (gappend (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gappend.

Definition: gpf gappend (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r)

then p gappend (result˜ (sv1 ), result˜ (sv2 ), s0 )

else r endif endlet

Event: Disable gcons.

Conservative Axiom: p gcons intro let s1 be p gcons (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, gcons (v1 , v2 ), s0 ))

∧ determinate (gcons (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p gcons.

Definition: gpf gcons (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in

if normal state (r) then p gcons (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Event: Disable grcons.

Conservative Axiom: p grcons intro let s1 be p grcons (v1 , v2 , s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, grcons (v1 , v2 ), s0 ))

∧ determinate (grcons (v1 , v2 )))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

          ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p grcons.

Definition: gpf grcons (sv1 , sv2 , s0 ) = let r be state check (list (sv1 , sv2 ), s0 )

in if normal state (r) then p grcons (result˜ (sv1 ), result˜ (sv2 ), s0 ) else r endif endlet

Definition: gpf apply binary op (op, sv1 , sv2 , s0 ) = if rule (op, prodn (tag ('binary operator, 'op), 'eq))

  ∨ rule (op, prodn (tag ('binary operator, 'op), 'equal))

then gpf gequal (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'ne)) then gpf gne (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'lt)) then gpf glt (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'le)) then gpf gle (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'gt)) then gpf ggt (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'ge)) then gpf gge (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'and)) then gpf gand (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'or)) then gpf gor (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'imp)) then gpf gimp (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'iff)) then gpf giff (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'star star)) then gpf gpower (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'star)) then gpf gtimes (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'slash)) then gpf gquotient (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'div)) then gpf gdiv (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'mod)) then gpf gmod (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'plus)) then gpf gplus (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'minus)) then gpf gsubtract (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'in)) then gpf gin (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'adjoin)) then gpf gadjoin (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'omit)) then gpf gomit (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'sub)) then gpf gsub (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'union)) then gpf gunion (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'intersect)) then gpf gintersect (sv1 , sv2 , s0 )

elseif rule (op, prodn (tag ('binary operator, 'op), 'difference))

then gpf gdifference (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'colon gt)) then gpf gcons (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'lt colon)) then gpf grcons (sv1 , sv2 , s0 ) elseif rule (op, prodn (tag ('binary operator, 'op), 'append)) then gpf gappend (sv1 , sv2 , s0 ) else mark state indeterminate (s0 ) endif

; ********************
;  Standard Functions
; ********************

Event: Disable std domain.

Conservative Axiom: p std domain intro let s1 be p std domain (d, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal))

→ (sequal (s1 , store value ('result~, std domain (d), s0 ))

∧ determinate (std domain (d)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p std domain.

Definition: gpf std domain (sd, s0 ) = let r be state check (sd, s0 )

in

if normal state (r) then p std domain (result˜ list (sd), s0 )

else r endif endlet

Event: Disable std first.

Conservative Axiom: p std first intro let s1 be p std first (d, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, std first (d), s0 ))

∧ determinate (std first (d)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p std first.

Definition: gpf std first (sd, s0 ) = let r be state check (sd, s0 )

in

if normal state (r) then p std first (result˜ list (sd), s0 )

else r endif endlet

Event: Disable std initial.

Conservative Axiom: p std initial intro let s1 be p std initial (d, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal))

→ (sequal (s1 , store value ('result~, std initial (d), s0 ))

∧ determinate (std initial (d)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p std initial.

Definition: gpf std initial (sd, s0 ) = let r be state check (sd, s0 )

in

if normal state (r) then p std initial (result˜ list (sd), s0 )

else r endif endlet

Event: Disable std last.

Conservative Axiom: p std last intro let s1 be p std last (d, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, std last (d), s0 ))

∧ determinate (std last (d)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p std last.

Definition: gpf std last (sd, s0 ) = let r be state check (sd, s0 )

in

if normal state (r) then p std last (result˜ list (sd), s0 )

else r endif endlet

Event: Disable std lower.

Conservative Axiom: p std lower intro let s1 be p std lower (d, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal))

→ (sequal (s1 , store value ('result~, std lower (d), s0 ))

∧ determinate (std lower (d)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p std lower.

Definition: gpf std lower (sd, s0 ) = let r be state check (sd, s0 )

in

if normal state (r) then p std lower (result˜ list (sd), s0 )

else r endif endlet

Event: Disable std max.

Conservative Axiom: p std max intro let s1 be p std max (d, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, std max (d), s0 ))

∧ determinate (std max (d)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p std max.

Definition: gpf std max (sd, s0 ) = let r be state check (sd, s0 )

in

if normal state (r) then p std max (result˜ list (sd), s0 )

else r endif endlet

Event: Disable std min.

Conservative Axiom: p std min intro let s1 be p std min (d, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal))

→ (sequal (s1 , store value ('result~, std min (d), s0 ))

∧ determinate (std min (d)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p std min.

Definition: gpf std min (sd, s0 ) = let r be state check (sd, s0 )

in

if normal state (r) then p std min (result˜ list (sd), s0 )

else r endif endlet

Event: Disable std nonfirst.

Conservative Axiom: p std nonfirst intro let s1 be p std nonfirst (d, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, std nonfirst (d), s0 ))

∧ determinate (std nonfirst (d)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p std nonfirst.

Definition: gpf std nonfirst (sd, s0 ) = let r be state check (sd, s0 )

in

if normal state (r) then p std nonfirst (result˜ list (sd), s0 )

else r endif endlet

Event: Disable std nonlast.

Conservative Axiom: p std nonlast intro let s1 be p std nonlast (d, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal))

→ (sequal (s1 , store value ('result~, std nonlast (d), s0 ))

∧ determinate (std nonlast (d)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p std nonlast.

Definition: gpf std nonlast (sd, s0 ) = let r be state check (sd, s0 )

in

if normal state (r) then p std nonlast (result˜ list (sd), s0 )

else r endif endlet

Event: Disable std null.

Conservative Axiom: p std null intro let s1 be p std null (d, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, std null (d), s0 ))

∧ determinate (std null (d)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p std null.

Definition: gpf std null (sd, s0 ) = let r be state check (sd, s0 )

in

if normal state (r) then p std null (result˜ list (sd), s0 )

else r endif endlet

Event: Disable std ord.

Conservative Axiom: p std ord intro let s1 be p std ord (d, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal))

→ (sequal (s1 , store value ('result~, std ord (d), s0 ))

∧ determinate (std ord (d)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p std ord.

Definition: gpf std ord (sd, s0 ) = let r be state check (sd, s0 )

in

if normal state (r) then p std ord (result˜ list (sd), s0 )

else r endif endlet

Event: Disable std pred.

Conservative Axiom: p std pred intro let s1 be p std pred (d, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, std pred (d), s0 ))

∧ determinate (std pred (d)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p std pred.

Definition: gpf std pred (sd, s0 ) = let r be state check (sd, s0 )

in

if normal state (r) then p std pred (result˜ list (sd), s0 ) else r endif endlet

Event: Disable std range.

Conservative Axiom: p std range intro let s1 be p std range (d, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal))

→ (sequal (s1 , store value ('result~, std range (d), s0 ))

∧ determinate (std range (d)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p std range.

Definition: gpf std range (sd, s0 ) = let r be state check (sd, s0 )

in

if normal state (r) then p std range (result˜ list (sd), s0 )

else r endif endlet

Event: Disable std scale.

Conservative Axiom: p std scale intro let s1 be p std scale (d, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, std scale (d), s0 ))

∧ determinate (std scale (d)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p std scale.

Definition: gpf std scale (sd, s0 ) = let r be state check (sd, s0 )

in

if normal state (r) then p std scale (result˜ list (sd), s0 )

else r endif endlet

Event: Disable std size.

Conservative Axiom: p std size intro let s1 be p std size (d, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal))

→ (sequal (s1 , store value ('result~, std size (d), s0 ))

∧ determinate (std size (d)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p std size.

Definition: gpf std size (sd, s0 ) = let r be state check (sd, s0 )

in

if normal state (r) then p std size (result˜ list (sd), s0 )

else r endif endlet

Event: Disable std succ.

Conservative Axiom: p std succ intro let s1 be p std succ (d, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, std succ (d), s0 ))

∧ determinate (std succ (d)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p std succ.

Definition: gpf std succ (sd, s0 ) = let r be state check (sd, s0 )

in

if normal state (r) then p std succ (result˜ list (sd), s0 )

else r endif endlet

Event: Disable std upper.

Conservative Axiom: p std upper intro let s1 be p std upper (d, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal))

→ (sequal (s1 , store value ('result~, std upper (d), s0 ))

∧ determinate (std upper (d)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p std upper.

Definition: gpf std upper (sd, s0 ) = let r be state check (sd, s0 )

in

if normal state (r) then p std upper (result˜ list (sd), s0 ) else r endif endlet

; ***********
;  Variables
; ***********

Conservative Axiom: p apply var intro let s1 be p apply var (fn, s0 , d) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 ,

store value ('result~, apply var (fn, map (s0 ), d), s0 )) ∧ determinate (apply var (fn, map (s0 ), d))))

∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p apply var.

Definition: gpf apply var (fn, s, d) = if normal state (s)

then if state componentp (fn, s)

then let r be state check (d, s)

in

if normal state (r)

then p apply var (fn, s, result˜ list (d))

else r endif endlet else set condition (s, 'routineerror) endif

else s endif

; **************
;  Bound Values
; **************

Event: Disable bound values.

Conservative Axiom: gpf bound values intro let s1 be gpf bound values (e, c, s0 , x) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → (sequal (s1 , store value ('result~, bound values (e, c, x), s0 ))

∧ all determinate (bound values (e, c, x)))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol gpf bound values.

; ***********************************
;  Space Allocation and Deallocation
; ***********************************

Conservative Axiom: allocate intro let s1 be allocate (k, v, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → sequal (s1 , store value (k, v, s0 ))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol allocate.

Conservative Axiom: allocate const intro let s1 be allocate const (k, v, sc, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → sequal (s1 , store const (k, v, sc, s0 ))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol allocate const.

Definition: gp deallocate locals (s) = deallocate vars (local vars (s),

deallocate consts (local consts (s), deallocate conds (local conds (s), s)))

; ******************
;  Name Expressions
; ******************
; A name expression is a marked object, with
;     mark = 'name_expression
;     object = (id . <evaluated selector_list>)

Definition: name exp (id, ss) = marked ('name expression, cons (id, ss))

Definition: namep (v) = (mark (v) = 'name expression)

Definition: ne name (v) = if namep (v) then car (object (v))

else f endif

Definition: ne selectors (v) = if namep (v) then cdr (object (v))

else nil endif

; ******************
;  Retyping Result~
; ******************
; This is used in constant interpretation.

Definition: retype result˜ (s, td) = if determinate (result˜ (s)) ∧ truep (in type (td, result˜ (s)))

then store value ('result~, marked (nil, typed (td, value (result˜ (s)))), s)

else set condition (s, 'routineerror) endif Conservative Axiom: p retype result˜ intro let s1 be p retype result˜ (s0 , td) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → sequal (s1 , retype result˜ (s0 , td))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p retype result˜ .

Definition: gpf retype result˜ (s, td) = if normal state (s) then p retype result˜ (s, td)

else s endif

; *******************************
;  Functions on Type Descriptors
; *******************************

Definition: subtype irange (t1 , t2 ) = if bounded typep (t1 )

then if bounded typep (t2 )

then if integerp (tmin (t1 )) ∧ integerp (tmax (t1 )) ∧ integerp (tmin (t2 )) ∧ integerp (tmax (t2 ))

then ileq (tmin (t2 ), tmin (t1 )) ∧ ileq (tmax (t1 ), tmax (t2 )) else f endif

else t endif elseif bounded typep (t2 ) then f else t endif

Definition: subtype rrange (t1 , t2 ) = if bounded typep (t1 )

then if bounded typep (t2 )

then if rationalp (tmin (t1 )) ∧ rationalp (tmax (t1 )) ∧ rationalp (tmin (t2 )) ∧ rationalp (tmax (t2 ))

then rleq (tmin (t2 ), tmin (t1 )) ∧ rleq (tmax (t1 ), tmax (t2 ))

else f endif else t endif

elseif bounded typep (t2 ) then f

else t endif

Definition: subtype size (s1 , s2 ) = if s1 = nil then s2 = nil

elseif s2 = nil then s1 ∈ N

elseif (s1 ∈ N) ∧ (s2 ∈ N) then s1 ≤ s2 else f endif

#|
(do-mutual '(
(defn subtype_fields (t1 t2)
  (if (nlistp t1)
      T
    (and (subtype (cdar t1) (mapped_value t2 (caar t1)))
 (subtype_fields (cdr t1) t2)))
  ( (lessp (tree_size t1)) ))
(defn subtype (t1 t2)
  (if (and (type_descp t1) (type_descp t2)
   (equal (mode t1) (mode t2)))
      (case (mode t1)
(integer (subtype_irange t1 t2))
(rational (subtype_rrange t1 t2))
(scalar (and (equal (tid t1) (tid t2))
     (equal (sid t1) (sid t2))
     (type_vequal (crd t1) (crd t2) (integer_desc))
     (subtype_irange t1 t2)))
(array (and (type_equal (selector_td t1) (selector_td t2))
    (subtype (component_td t1) (component_td t2))))
(record (and (set_equal (field_names t1) (field_names t2))
     (subtype_fields (field_tds t1) (field_tds t2))))
(mapping (and (subtype_size (max_size t1) (max_size t2))
      (subtype (selector_td t1) (selector_td t2))
      (subtype (component_td t1) (component_td t2))))
(sequence (and (subtype_size (max_size t1) (max_size t2))
       (subtype (component_td t1) (component_td t2))))
(set (and (subtype_size (max_size t1) (max_size t2))
  (subtype (component_td t1) (component_td t2))))
(pending (and (equal (tid t1) (tid t2))

(equal (sid t1) (sid t2))))
(otherwise F))
F)
( (lessp (tree_size t1)) ))
))
|#

Definition: mutual-subtype-subtype fields (mutual-flg, t1 , t2 ) = if mutual-flg = 'subtype

then if type descp (t1 ) ∧ type descp (t2 ) ∧ (mode (t1 ) = mode (t2 ))

then case on mode (t1 ): case = integer then subtype irange (t1 , t2 ) case = rational then subtype rrange (t1 , t2 ) case = scalar then (tid (t1 ) = tid (t2 ))

∧ (sid (t1 ) = sid (t2 ))

∧ type vequal (crd (t1 ), crd (t2 ), integer desc) ∧ subtype irange (t1 , t2 )

case = array then type equal (selector td (t1 ), selector td (t2 ))

∧ mutual-subtype-subtype fields ('subtype, component td (t1 ), component td (t2 ))

case = record then set equal (field names (t1 ), field names (t2 ))

∧ mutual-subtype-subtype fields ('subtype fields, field tds (t1 ), field tds (t2 ))

case = mapping then subtype size (max size (t1 ), max size (t2 ))

∧ mutual-subtype-subtype fields ('subtype, selector td (t1 ), selector td (t2 ))

∧ mutual-subtype-subtype fields ('subtype, component td (t1 ), component td (t2 ))

case = sequence then subtype size (max size (t1 ), max size (t2 ))

∧ mutual-subtype-subtype fields ('subtype, component td (t1 ), component td (t2 ))

case = set

then subtype size (max size (t1 ), max size (t2 ))

∧ mutual-subtype-subtype fields ('subtype, component td (t1 ), component td (t2 ))

case = pending

then (tid (t1 ) = tid (t2 )) ∧ (sid (t1 ) = sid (t2 )) otherwise f endcase

else f endif elseif t1 ≃ nil then t else mutual-subtype-subtype fields ('subtype,

cdar (t1 ),

mapped value (t2 , caar (t1 )))

∧ mutual-subtype-subtype fields ('subtype fields, cdr (t1 ), t2 ) endif

Definition: subtype (t1 , t2 ) = mutual-subtype-subtype fields ('subtype, t1 , t2 )

Definition: subtype fields (t1 , t2 ) = mutual-subtype-subtype fields ('subtype fields, t1 , t2 )

Definition: type check (td, s) = if determinate (result˜ (s)) ∧ truep (in type (td, result˜ (s))) then s

else set condition (s, 'routineerror) endif

Conservative Axiom: p type check intro let s1 be p type check (td, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → sequal (s1 , type check (td, s0 ))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p type check.

Definition: gpf type check (td, s) = if normal state (s) then p type check (td, s)

else s endif

; *********************
;  Type Name Arguments
; *********************

Definition: type name arg (tn, sn, s, x) = store value ('result~,

              marked ('type descriptor,

type desc (mk identifier (tn), sn, nil, x)), s)

Conservative Axiom: p type name arg intro let s1 be p type name arg (tn, sn, s0 , x) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → sequal (s1 , type name arg (tn, sn, s0 , x))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p type name arg.

Definition: gpf type name arg (tn, sn, s, x) = if normal state (s) then p type name arg (tn, sn, s, x)

else s endif

; **********************
;  Specification Values
; **********************

Definition: set entry (e, c, s, n, x) = let v be gf (e, c, map (s), n, x)

in

if boolean typep (type (v)) then store value ('entry, v, s)

else store value ('entry, marked (entry not boolean error (e, c),

default value (boolean desc)),

s) endif endlet

Conservative Axiom: p set entry intro let s1 be p set entry (e, c, s0 , n, x) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → sequal (s1 , set entry (e, c, s0 , n, x))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p set entry.

Definition: gp set entry (e, c, s, n, x) = if normal state (s) then p set entry (e, c, s, n, x)

else s endif

Definition: exit labels ok (cs, s) = (setp (cs) ∧ all conditionsp (cs, store cond ('normal, 'formal, s)))

Definition: set exit (e, c, s, n, x) = if exit labels ok (exit labels (e), s)

then let v be gf (postc (e, cond˜ (s)), c, map (s), n, x) in if boolean typep (type (v)) then store value ('exit, v, s) else store value ('exit,

marked (exit not boolean error (e, c),

default value (boolean desc)),

s) endif endlet

else store value ('exit,

marked (exit label error (e, c),

default value (boolean desc)),

s) endif

Conservative Axiom: p set exit intro let s1 be p set exit (e, c, s0 , n, x) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → sequal (s1 , set exit (e, c, s0 , n, x)))

∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p set exit.

Definition: gp set exit (e, c, s, n, x) = if normal state (s) then p set exit (e, c, s, n, x)

else s endif

Definition: update keep (s, c, n, x) = store value ('keep, gand (keep (s), gf (keep˜ (s), c, map (s), n, x)), s)

Conservative Axiom: p update keep intro let s1 be p update keep (s0 , c, n, x) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → sequal (s1 , update keep (s0 , c, n, x))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p update keep.

Definition: gp update keep (s, c, n, x) = if normal state (s) then p update keep (s, c, n, x)

else s endif

Definition: gp set keep (k, s, c, n, x) = if normal state (s) then gp update keep (allocate ('keep~, k, s), c, n, x)

else s endif

Definition: update assert (e, c, s, n, x) = store value ('assert, gand (assert (s), gf (e, c, map (s), n, x)), s)

Conservative Axiom: p update assert intro let s1 be p update assert (e, c, s0 , n, x) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal))

→ sequal (s1 , update assert (e, c, s0 , n, x))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p update assert.

Definition: gp update assert (e, c, s, n, x) = if normal state (s) then p update assert (e, c, s, n, x)

else s endif

Definition: record assert (v, s) = store value ('assert, gand (assert (s), v), s)

Conservative Axiom: p record assert intro let s1 be p record assert (v, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → sequal (s1 , record assert (v, s0 ))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p record assert.

Definition: gp record assert (v, s) = if normal state (s) then p record assert (v, s)

else s endif

; ************
;  Assignment
; ************

Definition: mapping selectionp (ss, td) = if ss ≃ nil then f

else case on mode (td): case = array then mapping selectionp (cdr (ss), component td (td)) case = record then mapping selectionp (cdr (ss),

field td (value (car (ss)), td))

case = mapping

then t

case = sequence

then mapping selectionp (cdr (ss), component td (td)) otherwise f endcase endif

Definition: mapping element lhsp (n, s) = if namep (n)

then mapping selectionp (ne selectors (n), type of (ne name (n), s)) else f endif

Definition: gassign0 (ne, v, s) = if namep (ne)

∧ variablep (ne name (ne), s)

∧ (¬ mapping element lhsp (ne, s)) then let id be ne name (ne),

ss be ne selectors (ne) in if state componentp (id, s) then let td be type of (id, s),

v2 be put op (state component (id, s), ss, v) in if determinate (v2 ) ∧ truep (in type (td, v2 )) then store value (id,

marked (nil,

typed (td, value (v2 ))), s)

else set condition (s, 'routineerror) endif endlet else set condition (s, 'routineerror) endif endlet

else set condition (s, 'routineerror) endif

Definition: gassign (ne, v, s, c, n, x) = gp update keep (gassign0 (ne, v, s), c, n, x)

Conservative Axiom: p assign intro let s1 be p assign (ne, v, s0 , c, n, x) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → sequal (s1 , gassign (ne, v, s0 , c, n, x))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

          ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p assign.

Definition: gp assign (sne, sv, s0 , c, n, x) = let r be state check (list (sne, sv), s0 )

in if normal state (r) then p assign (result˜ (sne), result˜ (sv), s0 , c, n, x) else r endif endlet

; ***************
;  New Statement
; ***************

Definition: gnew0 (dc, v, ne, s) = let id be ne name (ne),

ss be ne selectors (ne) in if rule (dc,

      prodn (tag ('new dynamic variable component,
                'dc),
            list ('into, tag ('name expression, 'ne))))

then gassign0 (name exp (id, rcdr (ss)),

gmap insert (apply var (id, map (s), rcdr (ss)), rcar (ss), v),

s)

elseif rule (dc,

          prodn (tag ('new dynamic variable component,
                   'dc),

list ('into,

                   'set,
                   tag ('name expression, 'ne))))

then gassign0 (ne, gadjoin (apply var (id, map (s), ss), v), s) elseif rule (dc,

          prodn (tag ('new dynamic variable component,
                   'dc),
                list ('before,
                   tag ('name expression, 'ne))))

then gassign0 (name exp (id, rcdr (ss)), gseq insert before (apply var (id, map (s), rcdr (ss)), rcar (ss), v),

s)

elseif rule (dc,

          prodn (tag ('new dynamic variable component,
                   'dc),
                list ('before,
                   'seq,
                   tag ('name expression, 'ne))))

then gassign0 (ne, gcons (v, apply var (id, map (s), ss)), s) elseif rule (dc,

          prodn (tag ('new dynamic variable component,
                   'dc),
                list ('behind,
                   tag ('name expression, 'ne))))

then gassign0 (name exp (id, rcdr (ss)),

gseq insert behind (apply var (id, map (s), rcdr (ss)), rcar (ss), v),

s)

elseif rule (dc,

          prodn (tag ('new dynamic variable component,
                   'dc),
                list ('behind,
                   'seq,
                   tag ('name expression, 'ne))))

then gassign0 (ne, grcons (apply var (id, map (s), ss), v), s) else mark state indeterminate (s) endif endlet

Definition: gnew (dc, v, ne, c, s, n, x) = gp update keep (gnew0 (dc, v, ne, s), c, n, x)

Conservative Axiom: p new intro let s1 be p new (dc, v, ne, c, s0 , n, x) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → sequal (s1 , gnew (dc, v, ne, c, s0 , n, x))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

          ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p new.

Definition: gp new (dc, sv, sne, c, s0 , n, x) = let r be state check (list (sv, sne), s0 )

in

if normal state (r)

then p new (dc, result˜ (sv), result˜ (sne), c, s0 , n, x)

else r endif endlet

; ******************
;  Remove Statement
; ******************

Definition: gremove0 (v, ne, s) = let id be ne name (ne),

ss be ne selectors (ne) in if v = nil then if mapping descp (type (apply var (id, map (s), rcdr (ss))))

then gassign0 (name exp (id, rcdr (ss)),

gmapomit (apply var (id, map (s), rcdr (ss)),

rcar (ss)),

s)

else gassign0 (name exp (id, rcdr (ss)),

gseqomit (apply var (id, map (s), rcdr (ss)),

rcar (ss)),

s) endif

else gassign0 (ne, gomit (apply var (id, map (s), ss), v), s) endif endlet

Definition: gremove (v, ne, c, s, n, x) = gp update keep (gremove0 (v, ne, s), c, n, x)

Conservative Axiom: p remove intro let s1 be p remove (v, ne, c, s0 , n, x) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → sequal (s1 , gremove (v, ne, c, s0 , n, x))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p remove.

Definition: gp remove (sv, sne, c, s0 , n, x) = let r be if sv = nil then state check (list (sne), s0 )

else state check (list (sv, sne), s0 ) endif

in

if normal state (r)

then p remove (if sv = nil then nil else result˜ (sv) endif, result˜ (sne), c, s0 , n, x)

else r endif endlet

; ****************
;  Move Statement
; ****************

Definition: stored value (n, s) = apply var (ne name (n), map (s), ne selectors (n))

Definition: gmove assign (cd, v, ne, s) = if rule (cd,

          prodn (tag ('component destination, 'd),
                tag ('new dynamic variable component, 'dc)))
    then gnew0 (subtree (cd, 'new dynamic variable component),

v, ne, s)

elseif rule (cd,

             prodn (tag ('component destination, 'd),
                   list ('to, tag ('name expression, 'ne))))

then if sequence descp (type (stored value (name exp (ne name (ne),

rcdr (ne selectors (ne))),

s))) then gassign0 (ne, v, s)

else set condition (s, 'routineerror) endif else mark state indeterminate (s) endif

Definition: same selectors (s1 , s2 ) = if s1 ≃ nil then s2 ≃ nil

elseif s2 ≃ nil then f else ((car (s1 ) = car (s2 )) ∨ gtruep (gequal (car (s1 ), car (s2 ))))

∧ same selectors (cdr (s1 ), cdr (s2 )) endif

Definition: same names (n1 , n2 ) = (namep (n1 )

∧ namep (n2 )

∧ (ne name (n1 ) = ne name (n2 ))

∧ same selectors (ne selectors (n1 ), ne selectors (n2 )))

Definition: remove dynamic name (rv, rne) = if rv = nil then name exp (ne name (rne), rcdr (ne selectors (rne)))

else rne endif

Definition: assign dynamic name (cd, nne) = if rule (cd,

          prodn (tag ('component destination, 'd),
                tag ('new dynamic variable component, 'dc)))

then assign dynamic name (subtree (cd,

                                   'new dynamic variable component),

nne)

elseif rule (cd,

             prodn (tag ('new dynamic variable component, 'dc),
                   list ('into, tag ('name expression, 'ne))))

∨ rule (cd,

                 prodn (tag ('new dynamic variable component,
                          'dc),
                       list ('before,
                          tag ('name expression, 'ne))))

∨ rule (cd,

                 prodn (tag ('new dynamic variable component,
                          'dc),
                       list ('behind,
                          tag ('name expression, 'ne))))

∨ rule (cd,

                 prodn (tag ('component destination, 'd),
                       list ('to, tag ('name expression, 'ne))))

then name exp (ne name (nne), rcdr (ne selectors (nne)))

else nne endif

Definition: gmove (rv, rne, cd, nne, c, s, n, x) = if same names (remove dynamic name (rv, rne), assign dynamic name (cd, nne)) then set condition (s, 'routineerror) else let r1 be gmove assign (cd,

if rv = nil

then stored value (rne, s) else rv endif, nne, s)

in if normal state (r1 ) then let r2 be gremove0 (rv, rne, s)

in if normal state (r2 ) then gp update keep (r2 , c, n, x) else marked (mark (r2 ),

map (set condition (s,

cond˜ (r2 )))) endif endlet

else r1 endif endlet endif

Conservative Axiom: p move intro let s1 be p move (rv, rne, cd, nne, c, s0 , n, x) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → sequal (s1 , gmove (rv, rne, cd, nne, c, s0 , n, x))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p move.

Definition: gp move (srv, srne, cd, snne, c, s, n, x) = let r be if srv = nil then state check (list (srne, snne), s)

else state check (list (srv, srne, snne), s) endif

in if normal state (r) then p move (if srv = nil then nil

else result˜ (srv) endif, result˜ (srne), cd, result˜ (snne), c, s, n, x)

else r endif endlet

; *****************
;  Procedure Calls
; *****************
; =======================================
;  Argument Checking for Procedure Calls
; =======================================
; ------------
;  Formals OK
; ------------

Definition: pformals ok (fs) = if fs ≃ nil then t

elseif reserved idp (car (fs)) then f elseif car (fs) ∈ cdr (fs) then f else pformals ok (cdr (fs)) endif

; -----------------
;  Aliasing Checks
; -----------------

Definition: selectors aliasedp (s1 , s2 ) = if (s1 ≃ nil) ∨ (s2 ≃ nil) then t

else ((car (s1 ) = car (s2 )) ∨ gtruep (gequal (car (s1 ), car (s2 )))) ∧ selectors aliasedp (cdr (s1 ), cdr (s2 )) endif

Definition: harmful aliasp (a1 , a2 , f1 , f2 ) = if (access (f1 ) = 'var) ∨ (access (f2 ) = 'var)

then if namep (a1 ) ∧ namep (a2 )

then (ne name (a1 ) = ne name (a2 ))

∧ selectors aliasedp (ne selectors (a1 ), ne selectors (a2 )) else f endif

else f endif

Definition: harmfully aliasedp (ap, as, fp, fs) = if as ≃ nil then f

else harmful aliasp (ap, car (as), fp, car (fs))

∨ harmfully aliasedp (ap, cdr (as), fp, cdr (fs)) endif Definition: no harmful aliasing (as, fs) = if as ≃ nil then t

elseif namep (car (as))

then (¬ harmfully aliasedp (car (as), cdr (as), car (fs), cdr (fs)))

∧ no harmful aliasing (cdr (as), cdr (fs)) else no harmful aliasing (cdr (as), cdr (fs)) endif

; ------------------------
;  Type and Access Checks
; ------------------------

Definition: one parg check (fp, ap, fsn, s, x) = let ft be type desc (formal type (fp), fsn, nil, x),

av be if namep (ap) then apply var (ne name (ap), map (s), ne selectors (ap)) else ap endif

in

if indeterminate (av) then set condition (s, 'routineerror) elseif access (fp) = 'var then if namep (ap)

∧ variablep (ne name (ap), s)

∧ (¬ mapping element lhsp (ap, s)) then if subtype (ft, type (av)) ∧ truep (in type (ft, av))

then s

else set condition (s, 'routineerror) endif else set condition (s, 'routineerror) endif

elseif truep (in type (ft, av)) then s

else set condition (s, 'routineerror) endif endlet

Event: Disable set condition.

Event: Disable one parg check.

Event: Disable normal state.

Definition: parg check2 (fs, as, fsn, s, x) = if as ≃ nil

then if fs ≃ nil then s else set condition (s, 'routineerror) endif elseif fs ≃ nil then set condition (s, 'routineerror) else let s2 be one parg check (car (fs), car (as), fsn, s, x)

in

if normal state (s2 )

then parg check2 (cdr (fs), cdr (as), fsn, s, x)

else s2 endif endlet endif

; ---------------------------------------------
;  The Full Argument Check for Procedure Calls
; ---------------------------------------------

Definition: cond arg check (fcs, acs, s) = if length (fcs) = length (acs)

then if all conditionsp (acs, s) then s

else mark state indeterminate (s) endif else set condition (s, 'routineerror) endif

Definition: parg check (u, usn, ads, acs, s, x) = let fds be formal dargs (u),

fcs be formal cargs (u) in case on kind (u): case = function then if pformals ok (append (cons ('result,

dparam name list (fds)), append (fcs,

                                '(routineerror
                                  spaceerror))))

∧ (farg check (fds, ads, usn, x) = nil) then cond arg check (fcs, acs, s) else set condition (s, 'routineerror) endif

case = procedure then if pformals ok (append (dparam name list (fds),

append (fcs,

                                 '(routineerror
                                   spaceerror))))

then let s2 be parg check2 (fds, ads, usn, s, x) in if normal state (s2 ) then if no harmful aliasing (ads, fds)

then cond arg check (fcs, acs, s) else set condition (s,

                                    'routineerror) endif

else s2 endif endlet else set condition (s, 'routineerror) endif otherwise set condition (s, 'routineerror) endcase endlet

; ==============================
;  New State for Procedure Call
; ==============================

Definition: padd darg (fp, ap, fsn, sa, s, x) = let ft be type desc (formal type (fp), fsn, nil, x),

av be if namep (ap) then apply var (ne name (ap), map (sa), ne selectors (ap)) else ap endif

in

let fv be marked (nil, typed (ft, value (av)))

in

if access (fp) = 'var

then store const (mk entry name (dparam name (fp)), fv,

                   'formal,

store var (dparam name (fp), fv,

                           'formal,

s))

else store const (dparam name (fp), fv, 'formal, s) endif endlet endlet

Definition: pbind dargs (fs, as, fsn, s, x) = if as ≃ nil then default state

else padd darg (rcar (fs), rcar (as), fsn, s, pbind dargs (rcdr (fs), rcdr (as), fsn, s, x),

x) endif

Definition: padd result (s, ftype) = let v be std initial (list (marked ('type descriptor, ftype)))

in

if determinate (v)

then store const (mk entry name ('result),

                   'formal,

store var ('result, v, 'formal, s))

else set condition (s, 'routineerror) endif endlet

Definition: call state (u, usn, ads, acs, s, x) = let r1 be parg check (u, usn, ads, acs, s, x)

in

if normal state (r1 )

then let r2 be note conds (formal cargs (u),

                            'formal,

pbind dargs (formal dargs (u), ads, usn, s, x))

in

if kind (u) = 'function

then let ftype be type desc (result type (u), usn, nil, x)

in

padd result (r2 , ftype) endlet else r2 endif endlet

else r1 endif endlet

Event: Disable call state.

Event: Disable determinate.

Event: Enable sequal.

Conservative Axiom: p call state intro (determinate (p call state (u, usn, ads, acs, s0 , x)) ∧ (¬ sequal (p call state (u, usn, ads, acs, s0 , x),

call state (u, usn, ads, acs, s0 , x))))

→ (cond˜ (p call state (u, usn, ads, acs, s0 , x))

     ∈ '(routineerror spaceerror))

Simultaneously, we introduce the new function symbol p call state. Event: Enable determinate.

Event: Disable sequal.

Definition: gp call state (u, usn, sads, acs, s, x) = let r be state check (sads, s)

in

if normal state (r)

then p call state (u, usn, result˜ list (sads), acs, s, x) else r endif endlet

; ===============================
;  State Update for Call Effects
; ===============================

Definition: map cond effects (fc, fcs, acs, s) = if fc = 'normal then s

    elseif fc ∈ '(routineerror spaceerror)

then set condition (s, fc) elseif listp (fcs) ∧ listp (acs) then if fc = car (fcs) then set condition (s, car (acs))

else map cond effects (fc, cdr (fcs), cdr (acs), s) endif else mark state indeterminate (s) endif

Definition: map var effects (fs, as, s2 , s1 ) = if fs ≃ nil then s1

elseif access (car (fs)) = 'var then map var effects (cdr (fs),

cdr (as), s2 , gassign0 (car (as),

state component (dparam name (car (fs)), s2 ), s1 ))

else map var effects (cdr (fs), cdr (as), s2 , s1 ) endif

Definition: map call effects (s2 , u, ads, acs, c, s1 , n, x) = if indeterminate (s2 ) then mark state indeterminate (s1 )

elseif kind (u) = 'function then if condition normal (s2 )

then allocate ('result~, state component ('result, s2 ), s1 ) else map cond effects (cond˜ (s2 ), formal cargs (u), acs, s1 ) endif else gp update keep (map cond effects (cond˜ (s2 ),

formal cargs (u),

acs,

map var effects (formal dargs (u), ads, s2 , s1 )),

c, n,

x) endif

Event: Enable sequal.

Conservative Axiom: gp map call effects intro sequal (gp map call effects (s2 , u, ads, acs, c, s1 , n, x),

map call effects (s2 , u, ads, acs, c, s1 , n, x))

Simultaneously, we introduce the new function symbol gp map call effects. Event: Disable sequal.

; =============
;  Local Names
; =============

Definition: gp new namep (id, s) = ((¬ in map (map (s), id))

∧ (¬ in map (cond+ (s), id)) ∧ (¬ reserved idp (id)))

; =================
;  Local Variables
; =================

Definition: bind local (a, id, td, iv, s) = if gp new namep (id, s)

then let v be if iv = nil

then std initial (list (marked ('type descriptor,

td)))

else iv endif

in if determinate (v) ∧ truep (in type (td, v)) then if a = 'var

then store var (id, marked (nil, typed (td, value (v))),

                           'local,

s)

else store const (id, marked (nil, typed (td, value (v))),

                            'local,

s) endif else set condition (s, 'routineerror) endif endlet

else set condition (s, 'routineerror) endif

Conservative Axiom: p bind local intro let s1 be p bind local (a, id, td, iv, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → sequal (s1 , bind local (a, id, td, iv, s0 ))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p bind local.

Definition: gp bind local (a, id, td, iv, s) = let r be if iv = nil then s

else state check (list (iv), s) endif

in

if normal state (r) then p bind local (a,

id, td, if iv = nil then iv else result˜ (iv) endif, s)

else r endif endlet

Definition: gp bind locals (a, ids, td, iv, s) = if ids ≃ nil then s

else gp bind locals (a, cdr (ids), td, iv, gp bind local (a, car (ids), td, iv, s)) endif

Definition: gp local conds (ids, s) = if (ids ≃ nil) ∨ (¬ normal state (s)) then s

elseif gp new namep (car (ids), s)

then gp local conds (cdr (ids), store cond (car (ids), 'local, s))

else set condition (s, 'routineerror) endif

; ****************
;  Case Statement
; ****************

Definition: case label check (k, cs, s) = let td be base type (type (k))

in

if non rational simple typep (td)

∧ (arg check (cs, ncopies (length (cs), td)) = nil)

∧ vsetp (values (cs), td) then s else set condition (s, 'routineerror) endif endlet

Conservative Axiom: p case label check intro let s1 be p case label check (k, cs, s0 ) in ((determinate (s1 ) ∧ (cond˜ (s1 ) = 'normal)) → sequal (s1 , case label check (k, cs, s0 ))) ∧ ((determinate (s1 ) ∧ (cond˜ (s1 ) ≠ 'normal))

→ (implementation constrained (s1 , s0 )

∧ (cond˜ (s1 )

              ∈ '(routineerror spaceerror)))) endlet

Simultaneously, we introduce the new function symbol p case label check.

Definition: gp case label check (sk, scs, s0 ) = let r be state check (cons (sk, scs), s0 )

in

if normal state (r)

then p case label check (result˜ (sk), result˜ list (scs), s0 )

else r endif endlet

Definition: condition labels ok (cs, s) = (setp (cs) ∧ all conditionsp (cs, s))

; **********************
;  The Meta-Function GP
; **********************

Event: Disable *1*boolean desc. Event: Disable gpf gand. Event: Disable gpf gchar. Event: Disable gpf gin. Event: Disable gpf gmap insert. Event: Disable gpf gmapomit. Event: Disable gpf gor. Event: Disable gpf grange elements. Event: Disable gpf gseq insert before. Event: Disable gpf gseq insert behind. Event: Disable gpf gseqomit. Event: Disable gpf gset. Event: Disable gpf gset or seq. Event: Disable gpf gstring seq. Event: Disable gpf apply binary op. Event: Disable gpf apply unary op.

Event: Disable gpf apply var. Event: Disable gpf bound values. Event: Disable gpf false. Event: Disable gpf minteger. Event: Disable gpf put op. Event: Disable gpf record get. Event: Disable gpf retype result˜. Event: Disable gpf select op. Event: Disable gpf std domain. Event: Disable gpf std first. Event: Disable gpf std initial. Event: Disable gpf std last. Event: Disable gpf std lower. Event: Disable gpf std max. Event: Disable gpf std min. Event: Disable gpf std nonfirst. Event: Disable gpf std nonlast. Event: Disable gpf std null.

Event: Disable gpf std ord. Event: Disable gpf std pred. Event: Disable gpf std range. Event: Disable gpf std scale. Event: Disable gpf std size. Event: Disable gpf std succ. Event: Disable gpf std upper. Event: Disable gpf subsequence get. Event: Disable gpf true. Event: Disable gpf type check. Event: Disable gpf type name arg. Event: Disable gp assign. Event: Disable gp bind locals. Event: Disable gp call state. Event: Disable gp case label check. Event: Disable gp deallocate locals. Event: Disable gp local conds. Event: Disable gp map call effects.

Event: Disable gp move. Event: Disable gp new. Event: Disable gp new namep. Event: Disable gp record assert. Event: Disable gp remove. Event: Disable gp set entry. Event: Disable gp set exit. Event: Disable gp set keep. Event: Disable gp update assert. Event: Disable gtruep. Event: Disable access. Event: Disable actual cargs. Event: Disable actual dargs. Event: Disable allocate. Event: Disable allocate const. Event: Disable arg list. Event: Disable base type. Event: Disable boolean desc.

Event: Disable bound id. Event: Disable case labels. Event: Disable cdr quantified exp. Event: Disable character valuep. Event: Disable condition labels ok. Event: Disable condition non normal. Event: Disable condition normal. Event: Disable conditionp. Event: Disable cond˜. Event: Disable constant body. Event: Disable digit listp. Event: Disable each clausep. Event: Disable entry name. Event: Disable entry valuep. Event: Disable exit spec. Event: Disable expression from spec. Event: Disable fn call formp. Event: Disable formal cargs.

Event: Disable formal dargs. Event: Disable gname. Event: Disable handler. Event: Disable handler labels. Event: Disable id list. Event: Disable identifierp. Event: Disable if else exp. Event: Disable if statement else part. Event: Disable indeterminate. Event: Disable internal initial value exp. Event: Disable keep spec. Event: Disable kind. Event: Disable length. Event: Disable map. Event: Disable map cond effects. Event: Disable mark state indeterminate. Event: Disable mk name expression. Event: Disable mk signal stmt.

Event: Disable mk unary operator. Event: Disable name exp. Event: Disable new name arg. Event: Disable normal state. Event: Disable object name. Event: Disable prec. Event: Disable procedure body. Event: Disable rcar. Event: Disable rcdr. Event: Disable ref. Event: Disable remove exp arg. Event: Disable remove name arg. Event: Disable reset leave to normal. Event: Disable result type. Event: Disable result˜. Event: Disable result˜ list. Event: Disable set condition. Event: Disable state componentp.

Event: Disable string valuep.

Event: Disable type.

Event: Disable type desc.

Event: Disable type name expp.

#|
(do-mutual '(
; ****************************************************************************
;
;                      THE EXPRESSION INTERPRETER
;
; ****************************************************************************
; ***************************
;  Set/Sequence Constructors
; ***************************
;; This returns a list of states rather than a single state.
(defn GPF_element_list (e c s n x)
  (if (not (normal_state s))
      (list s)
  (if (zerop (fix n))
      (list (mark_state_indeterminate s))
  (if (rule e (prodn (tag 'range 'r)
     (list 'OPEN_PAREN (tag 'range_limits 'r2) 'CLOSE_PAREN)))
      (GPF_element_list (subtree e 'range_limits) c s (sub1 n) x)
  (if (rule e (prodn (tag 'element_list 'e)
     (tag 'value_list 'v)))
      (GPF_element_list (subtree e 'value_list) c s (sub1 n) x)
  (if (rule e (prodn (tag 'element_list 'e)
     (tag 'range_limits 'r)))
      (GPF_element_list (subtree e 'range_limits) c s (sub1 n) x)

(if (rule e (prodn (tag 'range_limits 'r)
   (list (tag 'expression 'lo) 'DOT_DOT
 (tag 'expression 'hi))))
    (GPF_Grange_elements (GPF (subtree_i e 'expression 1) c s (sub1 n) x)
 (GPF (subtree_i e 'expression 2) c s (sub1 n) x)
 s)
(if (rule e (prodn (tag 'value_list 'v)
   (tag 'expression 'e)))
    (rcons nil (GPF (subtree e 'expression) c s (sub1 n) x))
(if (rule e (prodn (tag 'value_list 'v)
   (list (tag 'value_list 'v2) 'COMMA
 (tag 'expression 'e))))
    (rcons (GPF_element_list (subtree e 'value_list) c s (sub1 n) x)
   (GPF (subtree e 'expression) c s (sub1 n) x))
  (list (mark_state_indeterminate s))))))))))
( (lessp (count n)) ))

; Unlike most of the other functions here, this doesn't store the value in
; the state.
(defn GPF_element_type (e c s n x)
(if (zerop (fix n))
    (mark_state_indeterminate s)
(if (rule e (prodn (tag 'range 'r)
   (list 'OPEN_PAREN (tag 'range_limits 'r2) 'CLOSE_PAREN)))
    (GPF_element_type (subtree e 'range_limits) c s (sub1 n) x)
(if (rule e (prodn (tag 'element_list 'e)
   (tag 'value_list 'v)))
    (GPF_element_type (subtree e 'value_list) c s (sub1 n) x)
(if (rule e (prodn (tag 'element_list 'e)
   (tag 'range_limits 'r)))
    (GPF_element_type (subtree e 'range_limits) c s (sub1 n) x)
(if (rule e (prodn (tag 'range_limits 'r)

   (list (tag 'expression 'lo) 'DOT_DOT
 (tag 'expression 'hi))))
    (base_type (type (result~ (GPF (subtree_i e 'expression 1)
   c s (sub1 n) x))))
(if (rule e (prodn (tag 'value_list 'v)
   (tag 'expression 'e)))
    (base_type (type (result~ (GPF (subtree e 'expression) c s (sub1 n) x))))
(if (rule e (prodn (tag 'value_list 'v)
   (list (tag 'value_list 'v2) 'COMMA
 (tag 'expression 'e))))
    (GPF_element_type (subtree e 'value_list) c s (sub1 n) x)
  nil)))))))
( (lessp (count n)) ))

; ************************
;  Quantified expressions
; ************************
(defn GPF_all (id vs e c s n x)
(if (nlistp vs)
    (GPF_true s)
(if (GP_new_namep id s)
    (if (zerop n)
(mark_state_indeterminate s)
      (GPF_Gand (GPF_all id (rcdr vs) e c s (sub1 n) x)
(GPF e c (allocate_const id (rcar vs) 'local s) (sub1 n) x)
s))
  (set_condition s 'routineerror)))
( (lessp (count n)) ))

(defn GPF_some (id vs e c s n x)
(if (nlistp vs)
    (GPF_false s)
(if (GP_new_namep id s)
    (if (zerop n)
(mark_state_indeterminate s)
(GPF_Gor (GPF_some id (rcdr vs) e c s (sub1 n) x)

(GPF e c (allocate_const id (rcar vs) 'local s) (sub1 n) x)
s))
  (set_condition s 'routineerror)))
( (lessp (count n)) ))

; *********************
;  Value Modifications
; *********************
(defn GPF_each (id vs sBV e c s n x)
; e is the <component modification>
; sBV is the state whose result~ component is the value being modified
(if (not (normal_state s))
    s
(if (nlistp vs)
    sBV
(if (GP_new_namep id s)
    (if (zerop n)
(mark_state_indeterminate s)
(GPF_each id (cdr vs)
(GPF_modifiers sBV e c (allocate_const id (car vs) 'local s)
(sub1 n) x)
e c s (sub1 n) x))
  (set_condition s 'routineerror))))
( (lessp (count n)) ))

(defn GPF_adp (e c s n x)
(if (not (normal_state s))
    (list s)
(if (zerop (fix n))
    (list (mark_state_indeterminate s))
(if (rule e (prodn (tag 'arg_list 'as)
   (list 'OPEN_PAREN (tag 'value_list 'vs)
 'CLOSE_PAREN)))
    (GPF_adp (subtree e 'value_list) c s (sub1 n) x)
(if (rule e (prodn (tag 'value_list 'vs)
   (tag 'expression 'e)))
    (rcons nil (GPF (subtree e 'expression) c s (sub1 n) x))

(if (rule e (prodn (tag 'value_list 'vs)
(list (tag 'value_list 'vs2)
'COMMA (tag 'expression 'e))))
(rcons (GPF_adp (subtree e 'value_list) c s (sub1 n) x)
(GPF (subtree e 'expression) c s (sub1 n) x))
(list (mark_state_indeterminate s)))))))
( (lessp (count n)) ))
(defn GPF_selectors (e c s n x)
(if (not (normal_state s))
(list s)
(if (zerop (fix n))
(list (mark_state_indeterminate s))
(if (rule e (prodn (tag 'selector_list 's)
(tag 'component_selectors 's2)))
(GPF_selectors (subtree e 'component_selectors) c s (sub1 n) x)
(if (rule e (prodn (tag 'selector_list 's)
(list (tag 'selector_list 's2)
(tag 'component_selectors 's3))))
(append (GPF_selectors (subtree e 'selector_list) c s (sub1 n) x)
(GPF_selectors (subtree e 'component_selectors) c s (sub1 n) x))
(if (rule e (prodn (tag 'component_selectors 's)
(list 'DOT (tag 'IDENTIFIER 'fn))))
(list (allocate 'result~
(marked 'field_name (gname (subtree e 'IDENTIFIER)))
s))
(if (rule e (prodn (tag 'component_selectors 's)
(tag 'arg_list 'd)))
(GPF_adp (subtree e 'arg_list) c s (sub1 n) x)
(if (rule e (prodn (tag 'arg_list 'as)
(list 'OPEN_PAREN (tag 'value_list 'vs)
'CLOSE_PAREN)))
(GPF_adp (subtree e 'value_list) c s (sub1 n) x)

  (list (mark_state_indeterminate s)))))))))
( (lessp (count n)) ))
(defn GPF_modifiers (sBV e c s n x)
; e is the <value modifiers>
; sBV is the state whose result~ component is being modified
(if (not (normal_state s))
    s
(if (not (normal_state sBV))
    sBV
(if (zerop (fix n))
    (mark_state_indeterminate s)
(if (rule e (prodn (tag 'value_modifiers 'm)
   (tag 'component_selectors 's)))
    (GPF_modifiers sBV (subtree e 'component_selectors) c s (sub1 n) x)
(if (rule e (prodn (tag 'component_selectors 's)
   (list 'DOT (tag 'IDENTIFIER 'fn))))
    (GPF_record_get sBV
    (allocate 'result~
(marked 'field_name
(gname (subtree e 'IDENTIFIER)))
s)
    s)
(if (rule e (prodn (tag 'component_selectors 's)
   (tag 'arg_list 'd)))
    (GPF_select_op sBV (GPF_adp (subtree e 'arg_list) c s (sub1 n) x) s)
(if (rule e (prodn (tag 'value_modifiers 'm)
   (tag 'range 'r)))
    (GPF_modifiers sBV (subtree e 'range) c s (sub1 n) x)
(if (rule e (prodn (tag 'range 'r)
   (list 'OPEN_PAREN (tag 'range_limits 'r2)
 'CLOSE_PAREN)))
    (GPF_modifiers sBV (subtree e 'range_limits) c s (sub1 n) x)
(if (rule e (prodn (tag 'range_limits 'r)

(list (tag 'expression 'lo) 'DOT_DOT
(tag 'expression 'hi))))
 (GPF_subsequence_get sBV
(GPF (subtree_i e 'expression 1) c s (sub1 n) x)
(GPF (subtree_i e 'expression 2) c s (sub1 n) x)
s)
(if (rule e (prodn (tag 'value_modifiers 'm)
(tag 'value_alterations 'a)))
 (GPF_modifiers sBV (subtree e 'value_alterations) c s (sub1 n) x)
(if (rule e (prodn (tag 'value_alterations 'a)
(list 'WITH 'OPEN_PAREN
(tag 'component_alterations_list 'al)
'CLOSE_PAREN)))
 (GPF_modifiers sBV (subtree e 'component_alterations_list)
c s (sub1 n) x)
(if (rule e (prodn (tag 'component_alterations_list 'al)
(tag 'component_alterations 'a)))
 (GPF_modifiers sBV (subtree e 'component_alterations) c s (sub1 n) x)
(if (rule e (prodn (tag 'component_alterations_list 'al)
(list (tag 'component_alterations_list 'al2)
'SEMI_COLON (tag 'component_alterations 'a))))
 (GPF_modifiers (GPF_modifiers sBV
(subtree e 'component_alterations_list)
c s (sub1 n) x)
(subtree e 'component_alterations) c s (sub1 n) x)
(if (rule e (prodn (tag 'component_alterations 'as)
(list (tag 'opt_each_clause 'e)
(tag 'component_assignment 'a))))
 (if (each_clausep (subtree e 'opt_each_clause))
(let ((sVS (GPF_bound_values (subtree e 'opt_each_clause) c s x)))
(if (normal_state sVS)
(GPF_each (bound_id (subtree e 'opt_each_clause))
(result~ sVS) sBV (subtree e 'component_assignment)
c s (sub1 n) x)
 sVS))
(GPF_modifiers sBV (subtree e 'component_assignment) c s (sub1 n) x))
(if (rule e (prodn (tag 'component_alterations 'as)
(list (tag 'opt_each_clause 'e)

 (tag 'component_creation 'c))))
    (if (each_clausep (subtree e 'opt_each_clause))
(let ((sVS (GPF_bound_values (subtree e 'opt_each_clause) c s x)))
  (if (normal_state sVS)
(GPF_each (bound_id (subtree e 'opt_each_clause))
(result~ sVS) sBV (subtree e 'component_creation)
c s (sub1 n) x)
    sVS))
(GPF_modifiers sBV (subtree e 'component_creation) c s (sub1 n) x))
(if (rule e (prodn (tag 'component_alterations 'as)
   (list (tag 'opt_each_clause 'e)
 (tag 'component_deletion 'd))))
    (if (each_clausep (subtree e 'opt_each_clause))
(let ((sVS (GPF_bound_values (subtree e 'opt_each_clause) c s x)))
  (if (normal_state sVS)
(GPF_each (bound_id (subtree e 'opt_each_clause))
(result~ sVS) sBV (subtree e 'component_deletion)
c s (sub1 n) x)
    sVS))
(GPF_modifiers sBV (subtree e 'component_deletion) c s (sub1 n) x))
(if (rule e (prodn (tag 'component_assignment 'a)
   (list (tag 'selector_list 's)
 'COLON_EQUAL (tag 'expression 'e))))
    (GPF_put_op sBV
(GPF_selectors (subtree e 'selector_list)
c s (sub1 n) x)
(GPF (subtree e 'expression) c s (sub1 n) x)
s)
(if (rule e (prodn (tag 'component_creation 'c)
   (list 'BEFORE (tag 'selector_list 's)
 'COLON_EQUAL (tag 'expression 'e))))
    (let ((sS (GPF_selectors (subtree e 'selector_list) c s (sub1 n) x))
  (sU (GPF (subtree e 'expression) c s (sub1 n) x)))
(GPF_put_op sBV (rcdr sS)
  (GPF_Gseq_insert_before (GPF_select_op sBV (rcdr sS) s)
  (rcar sS) sU s)
  s))
(if (rule e (prodn (tag 'component_creation 'c)
   (list 'BEHIND (tag 'selector_list 's)
 'COLON_EQUAL (tag 'expression 'e))))

  (let ((sS (GPF_selectors (subtree e 'selector_list) c s (sub1 n) x))
(sU (GPF (subtree e 'expression) c s (sub1 n) x)))
(GPF_put_op sBV (rcdr sS)
(GPF_Gseq_insert_behind (GPF_select_op sBV (rcdr sS) s)
(rcar sS) sU s)
s))
(if (rule e (prodn (tag 'component_creation 'c)
 (list 'INTO (tag 'selector_list 's)
'COLON_EQUAL (tag 'expression 'e))))
  (let ((sS (GPF_selectors (subtree e 'selector_list) c s (sub1 n) x))
(sU (GPF (subtree e 'expression) c s (sub1 n) x)))
(GPF_put_op sBV (rcdr sS)
(GPF_Gmap_insert (GPF_select_op sBV (rcdr sS) s)
 (rcar sS) sU s)
s))
(if (rule e (prodn (tag 'component_deletion 'd)
 (list 'SEQOMIT (tag 'selector_list 's))))
  (let ((sS (GPF_selectors (subtree e 'selector_list) c s (sub1 n) x)))
(GPF_put_op sBV (rcdr sS)
(GPF_Gseqomit (GPF_select_op sBV (rcdr sS) s)
(rcar sS) s)
s))
(if (rule e (prodn (tag 'component_deletion 'd)
 (list 'MAPOMIT (tag 'selector_list 's))))
  (let ((sS (GPF_selectors (subtree e 'selector_list) c s (sub1 n) x)))
(GPF_put_op sBV (rcdr sS)
(GPF_Gmapomit (GPF_select_op sBV (rcdr sS) s)
(rcar sS) s)
s))
(mark_state_indeterminate s)))))))))))))))))))))))
( (lessp (count n)) ))

; ************************************
;  Name references and function calls
; ************************************
(defn GPF_apply_fun (fn adp acp sn s n x)

(if (zerop (fix n))
    (mark_state_indeterminate s)
  (let ((h (car (ref fn sn x)))  ; scope fn is declared in
(u (cdr (ref fn sn x)))) ; the function declaration
    (if (equal (kind u) 'function)
(let ((fs (formal_dargs u)))                    ; formals
(let ((ds (if (equal (length fs) 0) nil adp))   ; actuals
(ss (if (equal (length fs) 0) adp nil)))  ; selectors
  (GPF_select_op (GP_procedure_call fn ds acp sn s (sub1 n) x)
 ss s)))
    (if (equal (kind u) 'constant)
(if (equal acp nil)
    (GPF_select_op
       (GPF_retype_result~ (GPF (constant_body u) h s (sub1 n) x)
   (type_desc (result_type u) h nil x))
adp s)
  (set_condition s 'routineerror))
(set_condition s 'routineerror)))))
( (lessp (count n)) ))

(defn GPF_apply (fn adp acp sn s n x)
; adp is a list of states
(if (state_componentp fn s)
    (if (equal acp nil)
(GPF_apply_var fn s adp)
(set_condition s 'routineerror))
(if (equal fn 'false)
    (if (equal acp nil)
(GPF_select_op (GPF_false s) adp s)
(set_condition s 'routineerror))
(if (equal fn 'true)
    (if (equal acp nil)
(GPF_select_op (GPF_true s) adp s)
(set_condition s 'routineerror))
(if (type_name_expp fn adp sn x)
    (if (equal acp nil)
(GPF_type_name_arg fn sn s x)
(set_condition s 'routineerror))
(if (equal fn 'domain)
    (if (equal acp nil)
(GPF_std_domain adp s)
(set_condition s 'routineerror))
(if (equal fn 'first)

    (if (equal acp nil)
(GPF_std_first adp s)
(set_condition s 'routineerror))
(if (equal fn 'initial)
    (if (equal acp nil)
(GPF_std_initial adp s)
(set_condition s 'routineerror))
(if (equal fn 'last)
    (if (equal acp nil)
(GPF_std_last adp s)
(set_condition s 'routineerror))
(if (equal fn 'lower)
    (if (equal acp nil)
(GPF_std_lower adp s)
(set_condition s 'routineerror))
(if (equal fn 'max)
    (if (equal acp nil)
(GPF_std_max adp s)
(set_condition s 'routineerror))
(if (equal fn 'min)
    (if (equal acp nil)
(GPF_std_min adp s)
(set_condition s 'routineerror))
(if (equal fn 'nonfirst)
    (if (equal acp nil)
(GPF_std_nonfirst adp s)
(set_condition s 'routineerror))
(if (equal fn 'nonlast)
    (if (equal acp nil)
(GPF_std_nonlast adp s)
(set_condition s 'routineerror))
(if (equal fn 'null)
    (if (equal acp nil)
(GPF_std_null adp s)
(set_condition s 'routineerror))
(if (equal fn 'ord)
    (if (equal acp nil)
(GPF_std_ord adp s)
(set_condition s 'routineerror))
(if (equal fn 'pred)
    (if (equal acp nil)
(GPF_std_pred adp s)
(set_condition s 'routineerror))
(if (equal fn 'range)

    (if (equal acp nil)
(GPF_std_range adp s)
(set_condition s 'routineerror))
(if (equal fn 'scale)
    (if (equal acp nil)
(GPF_std_scale adp s)
(set_condition s 'routineerror))
(if (equal fn 'size)
    (if (equal acp nil)
(GPF_std_size adp s)
(set_condition s 'routineerror))
(if (equal fn 'succ)
    (if (equal acp nil)
(GPF_std_succ adp s)
(set_condition s 'routineerror))
(if (equal fn 'upper)
    (if (equal acp nil)
(GPF_std_upper adp s)
(set_condition s 'routineerror))
(if (zerop (fix n))
    (mark_state_indeterminate s)
  (GPF_apply_fun fn adp acp sn s (sub1 n) x)))))))))))))))))))))))
( (lessp (count n)) ))

(defn GPF_list (es c s n x)
(if (nlistp es)
    nil
(if (zerop (fix n))
    (list (mark_state_indeterminate s))
  (cons (GPF (car es) c s (sub1 n) x)
(GPF_list (cdr es) c s (sub1 n) x))))
( (lessp (count n)) ))
(defn GPF (e c s n x)
; The meta-function GPF(e,c,s,n,x) gives the state that results when the
; expression e is interpreted for at most n steps, in the context of scope
; c, initial state s, and Gypsy sentence x.
;
; The domain and range of GPF(e,c,s,n,x) are as follows:
;
; e is the parse tree of an expression which describes a mechanism.
; c is the (litatom) name of the Gypsy scope in which e appears.
; s is  the marked, initial state on which the expression mechanism

;   e begins to operate.
; n is the maximum number of steps that the expression mechanism is
;   allowed to operate.
; x is  the  parse  tree  of the program description sentence which
;   defines the library which  contains  the  declarations  of  the
;   Gypsy units which are referred to by e.
; gPF(e,c,s,n,x) is the marked, final state which results from operating the
;                mechanism on the initial state s for at most n steps.  If
;                the mechanism has not completed all of its operations in n
;                steps, then the final state is marked as indeterminate.
(if (not (normal_state s))
    s
(if (zerop (fix n))
    (mark_state_indeterminate s)

; ************************
;
;    <expression> ::= ...
;
; ************************
(if (rule e (prodn (tag 'expression 'e)
   (tag 'modified_primary_value 'm)))
    (GPF (subtree e 'modified_primary_value) c s (sub1 n) x)
(if (rule e (prodn (tag 'expression 'e)
   (list 'ALL (tag 'bound_expression 'b))))
    (let ((sVS (GPF_bound_values e c s x)))
(if (normal_state sVS)
  (GPF_all (bound_id (subtree e 'bound_expression))
   (result~ sVS) (cdr_quantified_exp e)
   c s (sub1 n) x)
sVS))
(if (rule e (prodn (tag 'expression 'e)
   (list 'SOME (tag 'bound_expression 'b))))
    (let ((sVS (GPF_bound_values e c s x)))
(if (normal_state sVS)
  (GPF_some (bound_id (subtree e 'bound_expression))
    (result~ sVS) (cdr_quantified_exp e)
    c s (sub1 n) x)

sVS))
(if (rule e (prodn (tag 'expression 'e)
   (list (tag 'unary_operator 'op) (tag 'expression 'e2))))
    (GPF_apply_unary_op (subtree e 'unary_operator)
(GPF (subtree e 'expression) c s (sub1 n) x)
s)
(if (rule e (prodn (tag 'expression 'e)
   (list (tag 'expression 'e1) (tag 'binary_operator 'op)
 (tag 'expression 'e2))))
    (GPF_apply_binary_op (subtree e 'binary_operator)
 (GPF (subtree_i e 'expression 1) c s (sub1 n) x)
 (GPF (subtree_i e 'expression 2) c s (sub1 n) x)
 s)

; ********************************
;
;    <modified primary value> ::=
;
; ********************************
(if (rule e (prodn (tag 'modified_primary_value 'm)
   (tag 'primary_value 'p)))
    (GPF (subtree e 'primary_value) c s (sub1 n) x)
(if (rule e (prodn (tag 'modified_primary_value 'm)
   (list (tag 'modified_primary_value 'm2)
 (tag 'value_modifiers 'vm))))
    (if (fn_call_formp e)
(GPF_apply (object_name (subtree e 'modified_primary_value))
   (GPF_adp (arg_list (subtree e 'value_modifiers))
    c s (sub1 n) x)
   nil c s (sub1 n) x)
(GPF_modifiers (GPF (subtree e 'modified_primary_value)
  c s (sub1 n) x)
     (subtree e 'value_modifiers) c s (sub1 n) x))
(if (rule e (prodn (tag 'modified_primary_value 'm)
   (list (tag 'modified_primary_value 'm2)
 (tag 'actual_condition_parameters 'cp))))
    (if (fn_call_formp e)
(GPF_apply (object_name (subtree e 'modified_primary_value))

   (GPF_adp (arg_list (subtree e 'modified_primary_value))
    c s (sub1 n) x)
   (actual_cargs e)
   c s (sub1 n) x)
(set_condition s 'routineerror))

; ***********************
;
;    <primary value> ::=
;
; ***********************
(if (rule e (prodn (tag 'primary_value 'p)
   (tag 'literal_value 'l)))
    (GPF (subtree e 'literal_value) c s (sub1 n) x)
(if (rule e (prodn (tag 'primary_value 'p)
   (tag 'set_or_sequence_value 's)))
    (GPF (subtree e 'set_or_sequence_value) c s (sub1 n) x)
(if (rule e (prodn (tag 'primary_value 'p)
   (tag 'ENTRY_VALUE 'e)))
    (GPF (subtree e 'ENTRY_VALUE) c s (sub1 n) x)
(if (rule e (prodn (tag 'primary_value 'p)
   (tag 'IDENTIFIER 'on)))
    (GPF (subtree e 'IDENTIFIER) c s (sub1 n) x)
(if (rule e (prodn (tag 'primary_value 'p)
   (tag 'if_expression 'i)))
    (GPF (subtree e 'if_expression) c s (sub1 n) x)
(if (rule e (prodn (tag 'primary_value 'p)
   (list 'OPEN_PAREN (tag 'expression 'e) 'CLOSE_PAREN)))
    (GPF (subtree e 'expression) c s (sub1 n) x)

; --------------------------------------------------------------------------
;
;  From here down to parse tree leaves, clauses are in alphabetical order
;  by the left-hand side of the productions.  Everything that is a parse
;  tree for an expression should be covered.
;

; --------------------------------------------------------------------------

; ***********************
;
;    <constant body> ::=
;
; ***********************
(if (rule e (prodn (tag 'constant_body 'b)
   (tag 'expression 'e)))
    (GPF (subtree e 'expression) c s (sub1 n) x)
(if (rule e (prodn (tag 'constant_body 'b)
   'PENDING))
    (mark_state_indeterminate s)

; ***********************
;
;    <if expression> ::=
;
; ***********************
(if (rule e (prodn (tag 'if_expression 'i)
   (list 'IF (tag 'expression 'b) 'THEN
 (tag 'expression 'p)
 (tag 'if_expression_else_part 'e))))
    ; Note:  this does not require all potential value expressions to be the
    ; same type or all boolean expressions to be boolean.
    (let ((bv (GPF_type_check (boolean_desc)
(GPF (subtree_i e 'expression 1)
   c s (sub1 n) x))))
(if (not (normal_state bv))
  bv
(if (Gtruep (result~ bv))
    (GPF (subtree_i e 'expression 2) c s (sub1 n) x)
  (GPF (if_else_exp (subtree e 'if_expression_else_part))
c s (sub1 n) x))))

; ***********************
;

;    <literal value> ::=
;
; ***********************
(if (rule e (prodn (tag 'literal_value 'l)
   (tag 'CHARACTER_VALUE 'ch)))
    (GPF (subtree e 'CHARACTER_VALUE) c s (sub1 n) x)
(if (rule e (prodn (tag 'literal_value 'l)
   (tag 'number 'n)))
    (GPF (subtree e 'number) c s (sub1 n) x)
(if (rule e (prodn (tag 'literal_value 'l)
   (tag 'STRING_VALUE 's)))
    (GPF (subtree e 'STRING_VALUE) c s (sub1 n) x)

; ****************
;
;    <number> ::=
;
; ****************
(if (rule e (prodn (tag 'number 'n)
   (tag 'DIGIT_LIST 's)))
    (GPF_minteger e s)
(if (rule e (prodn (tag 'number 'n)
   (list (tag 'base 'b) (tag 'DIGIT_LIST 's))))
    (GPF_minteger e s)

; *****************************************
;
;    <pre-computable label expression> ::=
;
; *****************************************
(if (rule e (prodn (tag 'pre_computable_label_expression 'p)
   (tag 'number 'n)))
    (GPF (subtree e 'number) c s (sub1 n) x)
(if (rule e (prodn (tag 'pre_computable_label_expression 'p)
   (list 'MINUS (tag 'number 'n))))

    (GPF_apply_unary_op (mk_unary_operator 'MINUS)
(GPF (subtree e 'number) c s (sub1 n) x)
s)
(if (rule e (prodn (tag 'pre_computable_label_expression 'p)
   (tag 'CHARACTER_VALUE 'ch)))
    (GPF (subtree e 'CHARACTER_VALUE) c s (sub1 n) x)
(if (rule e (prodn (tag 'pre_computable_label_expression 'p)
   (tag 'IDENTIFIER 'i)))
    (GPF (subtree e 'IDENTIFIER) c s (sub1 n) x)

; ********************************
;
;    <set or sequence value> ::=
;
; ********************************
(if (rule e (prodn (tag 'set_or_sequence_value 's)
   (list 'OPEN_PAREN (tag 'set_or_seq_mark 'm)
 (tag 'element_list 'e) 'CLOSE_PAREN)))
    (GPF_Gset_or_seq (subtree e 'set_or_seq_mark)
     (GPF_element_list (subtree e 'element_list)
c s (sub1 n) x)
     (GPF_element_type (subtree e 'element_list)
c s (sub1 n) x)
     s)
(if (rule e (prodn (tag 'set_or_sequence_value 's)
   (tag 'range 'r)))
    (GPF_Gset_or_seq nil
     (GPF_element_list (subtree e 'range) c s (sub1 n) x)
     (GPF_element_type (subtree e 'range) c s (sub1 n) x)
     s)

; *********************
;
;    PARSE TREE LEAVES
;
; *********************
(if (character_valuep e)

    (GPF_Gchar e s)
(if (digit_listp e)
    (GPF_minteger e s)
(if (entry_valuep e)
    (GPF_apply_var (entry_name e) s nil)
(if (identifierp e)
    (GPF_apply (gname e) nil nil c s (sub1 n) x)
(if (string_valuep e)
    (GPF_Gstring_seq e s)
  (mark_state_indeterminate s))))))))))))))))))))))))))))))))))))
( (lessp (count n)) ))

; ****************************************************************************
;
;                      THE PROCEDURAL INTERPRETER
;
; ****************************************************************************
; ==========================================================
;  Computation of Actual Data Parameters for Procedure Call
; ==========================================================
(defn GP_parg (e c s n x)
(if (zerop (fix n))
    (mark_state_indeterminate s)
  (let ((e2 (mk_name_expression e)))
    (if (rule e2 (prodn (tag 'name_expression 'e)
(tag 'IDENTIFIER 'i)))
(let ((vn (gname (subtree e2 'IDENTIFIER))))
  (let ((r (GPF_apply_var vn s nil)))
    (if (normal_state r)
(allocate 'result~ (name_exp vn nil) s)
r)))
    (if (rule e2 (prodn (tag 'name_expression 'e)
(list (tag 'IDENTIFIER 'i)

(tag 'selector_list 'ss))))
(let ((vn (gname (subtree e2 'IDENTIFIER)))
(ss (GPF_selectors (subtree e2 'selector_list)
 c s (sub1 n) x)))
  (let ((r (GPF_apply_var vn s ss)))
    (if (normal_state r)
(allocate 'result~ (name_exp vn (result~_list ss)) s)
r)))
(GPF e c s (sub1 n) x)))))
( (lessp (count n)) ))
(defn GP_parg_list (as c s n x)
(if (nlistp as)
    nil
(if (zerop (fix n))
    (list (mark_state_indeterminate s))
  (cons (GP_parg (car as) c s (sub1 n) x)
(GP_parg_list (cdr as) c s (sub1 n) x))))
( (lessp (count n)) ))

; ====================
;  The Procedure Call
; ====================
(defn GP_procedure_call (pn Sadp acp c s n x)
; pn is the called procedure name
; Sadp is the list of states resulting from evaluation of actual data
;      parameters
; acp is the list of actual condition paramters
; entry (normal_state s)
(if (zerop (fix n))
    (mark_state_indeterminate s)
  (let ((h (car (ref pn c x)))
(u (cdr (ref pn c x))))
    (if (or (equal (kind u) 'procedure)
    (equal (kind u) 'function))
(let ((s1 (GP_call_state u h Sadp acp s x)))
  (if (normal_state s1)
(GP_map_call_effects
(GP_procedure_body (procedure_body u) h s1 (sub1 n) x)

  u (result~_list Sadp) acp c s n x)
      (map_cond_effects (cond~ s1) (formal_cargs u) acp
(marked (mark s1) (map s)))))
(set_condition s 'routineerror)))) ; indeterminate?
  ( (lessp (count n)) ))
(defn GP_procedure_body (m c s n x)
  (if (zerop (fix n))
      (mark_state_indeterminate s)
  (if (rule m (prodn (tag 'procedure_body 'b)
     'PENDING))
      (mark_state_indeterminate s)
  (if (rule m (prodn (tag 'procedure_body 'b)
     (list 'BEGIN
   (tag 'external_operational_specification 'es)
   (tag 'opt_internal_environment 'iv)
   (tag 'opt_keep_specification 'k)
   (tag 'opt_internal_statements 'st)
   'END)))
      (let ((r (GP_deallocate_locals
(GP (subtree m 'opt_internal_statements)
    c
    (GP_set_keep
     (keep_spec m)
     (GP_locals (subtree m 'opt_internal_environment)
c
(GP_set_entry (prec m) c s n x)
(sub1 n) x)
     c n x)
    (sub1 n) x))))
(if (indeterminate r)
    r
(if (or (equal (cond~ r) 'normal)
(conditionp (cond~ r) r))
    (GP_set_exit (exit_spec m) c r n x)
(if (equal (cond~ r) 'leave)
    ; leave statement was not in a loop
    (set_condition r 'routineerror)
  ; condition signalled was not a forward condition; we are not
  ; allowed to signal routineerror
  (mark_state_indeterminate r)))))

(mark_state_indeterminate s))))
( (lessp (count n)) ))
(defn GP_locals (m c s n x)
(if (not (normal_state s))
    s
(if (zerop n)
    (mark_state_indeterminate s)
(if (rule m (prodn (tag 'opt_internal_environment 'iv)
   'empty))
    s
(if (rule m (prodn (tag 'opt_internal_environment 'iv)
   (tag 'internal_environment 'iv2)))
    (GP_locals (subtree m 'internal_environment) c s (sub1 n) x)
(if (rule m (prodn (tag 'internal_environment 'iv)
   (tag 'internal_data_or_condition_objects 'iv2)))
    (GP_locals (subtree m 'internal_data_or_condition_objects)
c s (sub1 n) x)
(if (rule m (prodn (tag 'internal_environment 'iv)
   (list (tag 'internal_environment 'iv2)
 (tag 'internal_data_or_condition_objects 'iv3))))
    (GP_locals (subtree m 'internal_data_or_condition_objects) c
(GP_locals (subtree m 'internal_environment) c s (sub1 n) x)
(sub1 n) x)
(if (rule m (prodn (tag 'internal_data_or_condition_objects 'iv)
   (list (tag 'access_specification 'a)
 (tag 'identifier_list 'is) 'COLON
 (tag 'type_specification 'ts)
 (tag 'opt_internal_initial_value 'v)
 'SEMI_COLON)))
    (let ((ie (internal_initial_value_exp m)))
    (let ((iv (if (equal ie nil)
  ie
(GPF ie c s (sub1 n) x))))
(GP_bind_locals (access m)

(id_list (subtree m 'identifier_list))
(type_desc (subtree m 'type_specification) c nil x)
iv s)))
  (if (rule m (prodn (tag 'internal_data_or_condition_objects 'iv)
     (list 'COND (tag 'identifier_list 'is) 'SEMI_COLON)))
      (GP_local_conds (id_list (subtree m 'identifier_list)) s)
    (mark_state_indeterminate s)))))))))
  ( (lessp (count n)) ))

; ****************
;  Case Statement
; ****************
(defn GP_case_body (k m c s n x)
  (if (not (normal_state s))
      s
  (if (zerop (fix n))
      (mark_state_indeterminate s)
  (if (rule m (prodn (tag 'case_composition_body 'b)
     'empty))
      s
  (if (rule m (prodn (tag 'case_composition_body 'b)
     (list 'ELSE 'COLON (tag 'opt_internal_statements 'ss))))
      (GP (subtree m 'opt_internal_statements) c s (sub1 n) x)
  (if (rule m (prodn (tag 'case_composition_body 'b)
     (list 'IS (tag 'case_labels 'cs) 'COLON
   (tag 'opt_internal_statements 'ss)
   (tag 'case_composition_body 'b2))))
      (let ((s1 (GPF_Gin k
 (GPF_Gset (GPF_list (case_labels m) c s (sub1 n) x)
   (base_type (type (result~ k)))
   s)
 s)))

(if (normal_state s1)
    (if (Gtruep (result~ s1))
(GP (subtree m 'opt_internal_statements) c s (sub1 n) x)
      (GP_case_body k (subtree m 'case_composition_body)
    c s (sub1 n) x))
  s1))
    (mark_state_indeterminate s))))))
  ( (lessp (count n)) ))

; ****************************************************************
;
;                     HANDLING CONDITIONS
;
;  <opt_condition_handlers> ::= <empty> | WHEN <opt handler list>
;  <opt_handler_list> ::= empty | <handler_list>
;  <handler_list> ::= <handler> { <handler> }
;
; ****************************************************************
(defn GP_cond (m c s n x)
  (if (or (indeterminate s) (condition_normal s))
      s
  (if (or (zerop n)
  (not (condition_labels_ok (handler_labels m) s)))
      (mark_state_indeterminate s)
    (let ((h (handler m (cond~ s))))
      (if (equal h nil)
  s
(GP h c (set_condition s 'normal) (sub1 n) x)))))
  ( (lessp (count n)) ))

;; **** The strange commented characters in the following function allow GNU
;;      Emacs to count parentheses correctly.

(defn GP (m c s n x)
  ; The meta-function GP (m,c,s,n,x) gives the state that results
  ; when the program fragment m is interpreted for at most n steps, in the

; context of scope c, initial state s, and Gypsy sentence x.
;
; The domain and range of GP (m,c,s,n,x) are as follows:
;
; m is the parse tree which describes a computer program mechanism.
; c is the (litatom) name of the Gypsy scope in which m appears.
; s is the marked, initial state on which the mechanism m begins to operate.
; n is the maximum number of steps  the  mechanism  is  allowed  to perform.
; x is  the  parse  tree  of the program description sentence which
;   defines the library which  contains  the  declarations  of  the
;   Gypsy units which are referred to by m.
; GP(m,c,s,n,x) is  the  marked,  final  state which results from operating
;               the mechanism on the initial state s for at most n steps.
;               If the mechanism  has  not  completed all of its operation
;               in n steps, then the final state is marked as indeterminate.
(if (not (normal_state s))
    s
(if (zerop (fix n))
    (mark_state_indeterminate s)

; ***************************************************
;
;                  STATEMENT LISTS
;
;  <statement list> ::= <statement> {; <statement> }
;
; ***************************************************
(if (rule m (prodn (tag 'statement_list 'ss)
   (tag 'statement 's)))
    (GP (subtree m 'statement) c s (sub1 n) x)
(if (rule m (prodn (tag 'statement_list 'ss)
   (list (tag 'statement_list 'ss2) 'SEMI_COLON
 (tag 'statement 's))))
    (GP (subtree m 'statement)
c
(GP (subtree m 'statement_list) c s (sub1 n) x)
(sub1 n)
x)

; *************************************************************************
;
;  <statement> ::=   <procedural statement> | <procedure composition rule>
;                  | <assert specification>
;
; *************************************************************************
(if (rule m (prodn (tag 'statement 's)
   (tag 'procedural_statement 's2)))
    (GP (subtree m 'procedural_statement) c s (sub1 n) x)
(if (rule m (prodn (tag 'statement 's)
   (tag 'procedure_composition_rule 's2)))
    (GP (subtree m 'procedure_composition_rule) c s (sub1 n) x)
(if (rule m (prodn (tag 'statement 's)
   (tag 'assert_specification 's2)))
    (GP (subtree m 'assert_specification) c s (sub1 n) x)

; ************************************************************
;
;                  PROCEDURAL STATEMENT
;
;  <procedural statement> ::=   <assignment statement>
;                             | <leave statement>
;                             | <move statement>
;                             | <new statement>
;                             | <procedure statement>
;                             | <remove statement>
;                             | <signal statement>
;
; ************************************************************
(if (rule m (prodn (tag 'procedural_statement 's)
   (tag 'assignment_statement 's2)))
    (GP (subtree m 'assignment_statement) c s (sub1 n) x)
(if (rule m (prodn (tag 'procedural_statement 's)
   (tag 'leave_statement 's2)))
    (GP (subtree m 'leave_statement) c s (sub1 n) x)
(if (rule m (prodn (tag 'procedural_statement 's)
   (tag 'move_statement 's2)))

    (GP (subtree m 'move_statement) c s (sub1 n) x)
(if (rule m (prodn (tag 'procedural_statement 's)
   (tag 'new_statement 's2)))
    (GP (subtree m 'new_statement) c s (sub1 n) x)
(if (rule m (prodn (tag 'procedural_statement 's)
   (tag 'procedure_statement 's2)))
    (GP (subtree m 'procedure_statement) c s (sub1 n) x)
(if (rule m (prodn (tag 'procedural_statement 's)
   (tag 'remove_statement 's2)))
    (GP (subtree m 'remove_statement) c s (sub1 n) x)
(if (rule m (prodn (tag 'procedural_statement 's)
   (tag 'signal_statement 's2)))
    (GP (subtree m 'signal_statement) c s (sub1 n) x)

; **********************
;
;  ASSIGNMENT STATEMENT
;
; **********************
(if (rule m (prodn (tag 'assignment_statement 's)
   (list (tag 'name_expression 'n) 'COLON_EQUAL
 (tag 'expression 'e))))
    (GP_assign (GP_parg (subtree m 'name_expression) c s (sub1 n) x)
(GPF (subtree m 'expression) c s (sub1 n) x)
s c n x)

; *****************
;
;  LEAVE STATEMENT
;
; *****************
(if (rule m (prodn (tag 'leave_statement 's)
   'LEAVE))
    (set_condition s 'leave)

; *************************************************************************
;
;                             MOVE STATEMENT
;
;  <move_statement> ::= MOVE <removable component> <component destination>
;  <component destination> ::=   <new dynamic variable component>
;                              | TO <sequence element name expression>
;
; *************************************************************************
                                                                     ; |<<
(if (rule m (prodn (tag 'move_statement 's)
   (list 'MOVE (tag 'removable_component 'c)
 (tag 'component_destination 'd))))
    (let ((e (remove_exp_arg m)))
(GP_move (if (equal e nil) nil (GPF e c s (sub1 n) x))
(GP_parg (remove_name_arg m) c s (sub1 n) x)
(subtree m 'component_destination)
(GP_parg (new_name_arg m) c s (sub1 n) x)
c s n x))

; ***********************************************************************
;
;                           NEW STATEMENT
;
;  <new_statement> ::= NEW <expression> <new dynamic variable component>
;
; ***********************************************************************
(if (rule m (prodn (tag 'new_statement 's)
   (list 'NEW (tag 'expression 'e)
 (tag 'new_dynamic_variable_component 'dc))))
    (GP_new (subtree m 'new_dynamic_variable_component)
    (GPF (subtree m 'expression) c s (sub1 n) x)
    (GP_parg (new_name_arg m) c s (sub1 n) x)
    c s n x)

; ****************
;
;  PROCECURE CALL
;
; ****************

(if (rule m (prodn (tag 'procedure_statement 's)
   (list (tag 'IDENTIFIER 'pn)
 (tag 'arg_list 'dp)
 (tag 'opt_actual_condition_parameters 'cp))))
    (GP_procedure_call (gname (subtree m 'identifier))
(GP_parg_list (actual_dargs m) c s (sub1 n) x)
(actual_cargs m)
c s (sub1 n) x)

; **********************************************************
;
;                     REMOVE STATEMENT
;
;  <remove_statement> ::= REMOVE <removable component>
;  <removable component> ::=
;           ELEMENT <expression> FROM SET <name expression>
;         | <name expression>
;
; **********************************************************
                                                                  ; |
(if (rule m (prodn (tag 'remove_statement 's)
   (list 'REMOVE (tag 'removable_component 'c))))
    (let ((e (remove_exp_arg m)))
(GP_remove (if (equal e nil) nil (GPF e c s (sub1 n) x))
 (GP_parg (remove_name_arg m) c s (sub1 n) x)
 c s n x))

; ******************
;
;  SIGNAL STATEMENT
;
; ******************
(if (rule m (prodn (tag 'signal_statement 's)
   (list 'SIGNAL (tag 'IDENTIFIER 'c))))
    (if (conditionp (gname (subtree m 'IDENTIFIER)) s)
(set_condition s (gname (subtree m 'IDENTIFIER)))
(mark_state_indeterminate s))

; ***********************************************************************
;

;                       PROCEDURE COMPOSITION
;
;  <procedure composition> ::   <if_composition> | <case_composition>
;                             | <loop_composition> | <begin_composition>
;
; ***********************************************************************
                                                                     ; |
(if (rule m (prodn (tag 'procedure_composition_rule 's)
   (tag 'if_composition 's2)))
    (GP (subtree m 'if_composition) c s (sub1 n) x)
(if (rule m (prodn (tag 'procedure_composition_rule 's)
   (tag 'case_composition 's2)))
    (GP (subtree m 'case_composition) c s (sub1 n) x)
(if (rule m (prodn (tag 'procedure_composition_rule 's)
   (tag 'loop_composition 's2)))
    (GP (subtree m 'loop_composition) c s (sub1 n) x)
(if (rule m (prodn (tag 'procedure_composition_rule 's)
   (tag 'begin_composition 's2)))
    (GP (subtree m 'begin_composition) c s (sub1 n) x)

; *******************************************************************
;
;                         IF COMPOSITION
;
;  <if composition> ::=
;         IF <boolean expression> THEN <opt internal statements>
;           <if composition else part>
;           <opt condition handlers>
;         END
;
;  <if composition else part> ::=
;           <empty>
;         | ELSE <opt internal statements>
;         | ELIF <boolean expression> THEN <opt internal statements>
;                <if composition else part>
;
; *******************************************************************
(if (rule m (prodn (tag 'if_composition 's)
                   (list 'IF (tag 'expression 'b) 'THEN

 (tag 'opt_internal_statements 'ss)
 (tag 'if_composition_else_part 'ep)
 (tag 'opt_condition_handlers 'cs) 'END)))
    (let ((bv (GPF_type_check (boolean_desc)
(GPF (subtree m 'expression)
   c s (sub1 n) x)))
  (ep (if_statement_else_part m)))
(GP_cond (subtree m 'opt_condition_handlers) c
(if (normal_state bv)
   (if (Gtruep (result~ bv))
(GP (subtree m 'opt_internal_statements)
   c s (sub1 n) x)
     (if (equal ep nil)
 s
(GP ep c s (sub1 n) x)))
 bv)
(sub1 n) x))

; **************************************************************************
;
;                           CASE COMPOSITION
;
;  <case composition> ::= CASE <label expression>
;                          { IS <case labels> : [ <internal statements> ] }
;                          [ ELSE             : [ <internal statements> ] ]
;                          [ <condition handlers> ]
;                         END
;
; **************************************************************************
(if (rule m (prodn (tag 'case_composition 's)
   (list 'CASE (tag 'expression 'e)
 (tag 'case_composition_body 'b)
 (tag 'opt_condition_handlers 'c) 'END)))
    (let ((k (GPF (subtree m 'expression) c s (sub1 n) x)))
    (let ((r (GP_case_label_check k
  (GPF_list (case_labels m) c s (sub1 n) x)
  s)))
(GP_cond (subtree m 'opt_condition_handlers) c
(if (normal_state r)
   (GP_case_body k (subtree m 'case_composition_body)
 c s (sub1 n) x)
 r)

(sub1 n) x)))

; *******************************************************
;
;                   LOOP COMPOSITION
;
;  <loop composition> ::= LOOP [ <internal statements> ]
;                              [ <condition handlers> ]
;                         END
;
; *******************************************************
(if (rule m (prodn (tag 'loop_composition 's)
   (list 'LOOP (tag 'opt_internal_statements 'ss)
 (tag 'opt_condition_handlers 'c) 'END)))
    (let ((p1 (GP (subtree m 'opt_internal_statements) c s (sub1 n) x)))
(GP_cond (subtree m 'opt_condition_handlers) c
(if (condition_non_normal p1)
   (reset_leave_to_normal p1)
 (GP m c p1 (sub1 n) x))
(sub1 n) x))

; *********************************************************
;
;                     BEGIN COMPOSITION
;
;  <begin composition> ::= BEGIN [ <internal statements> ]
;                                [ <condition handlers> ]
;                          END
;
; *********************************************************
(if (rule m (prodn (tag 'begin_composition 's)
   (list 'BEGIN (tag 'opt_internal_statements 'ss)
 (tag 'opt_condition_handlers 'c) 'END)))
    (GP_cond (subtree m 'opt_condition_handlers) c
     (GP (subtree m 'opt_internal_statements) c s (sub1 n) x)
     (sub1 n) x)

; **************************************************************
;

;                      INTERNAL STATEMENTS
;
;  <opt_internal_statements> ::= <empty> | <statement list> [;]
;                                        | PENDING [;]
;
; **************************************************************
(if (rule m (prodn (tag 'opt_internal_statements 'ss)
   'empty))
    s
(if (rule m (prodn (tag 'opt_internal_statements 'ss)
   (list (tag 'statement_list 'ss2) 'opt_semi_colon)))
    (GP (subtree m 'statement_list) c s (sub1 n) x)
(if (rule m (prodn (tag 'opt_internal_statements 'ss)
   (list 'PENDING 'opt_semi_colon)))
    (mark_state_indeterminate s)

; **********************
;
;  ASSERT SPECIFICATION
;
; **********************
; Whenever an assertion is encountered in executable code, it is evaluated
; and the result AND'd to the assertion-accumulator component of the map.
(if (rule m (prodn (tag 'assert_specification 's)
   (list 'ASSERT (tag 'specification_expression 'e))))
    (GP (subtree m 'specification_expression) c s (sub1 n) x)
(if (rule m (prodn (tag 'specification_expression 'e)
   (tag 'non_validated_specification_expression 'e2)))
    (GP_update_assert (expression_from_spec m) c s n x)
(if (or (rule m (prodn (tag 'specification_expression 'e)
(tag 'validated_specification_expression 'e2)))
(rule m (prodn (tag 'specification_expression 'e)
(list 'OPEN_PAREN
     (tag 'validated_specification_expression 'e2)
     'CLOSE_PAREN))))
    (GP (subtree m 'validated_specification_expression)

c s (sub1 n) x)
(if (rule m (prodn (tag 'validated_specification_expression 'e)
(list (tag 'non_validated_specification_expression 'e2)
'OTHERWISE (tag 'IDENTIFIER 'i))))
(let ((r (GPF_type_check (boolean_desc)
(GPF (expression_from_spec m)
c s (sub1 n) x))))
(if (normal_state r)
(if (Gtruep (result~ r))
(GP_record_assert (result~ r) s)
(GP (mk_signal_stmt (subtree m 'IDENTIFIER))
c (GP_record_assert (result~ r) s) (sub1 n) x))
r))
(mark_state_indeterminate s)))))))))))))))))))))))))))))))))))))
( (lessp (count n)) ))
))
|#

Definition: mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list (mutual-flg,

acp, adp, as, c, e, es, fn, id, k, m, n, pn, s, sadp, sbv, sn, vs, x)

= case on mutual-flg: case = gp then if ¬ normal state (s) then s

elseif fix (n) ≃ 0 then mark state indeterminate (s) elseif rule (m,

prodn (tag ('statement list, 'ss),
tag ('statement, 's)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'statement),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('statement list, 'ss),
list (tag ('statement list, 'ss2),
'semi colon,
tag ('statement, 's))))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'statement),

n − 1, t, mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp,

t, t, t, c, t, t, t, t, t, subtree (m,

                                                                                                                        'statement list),

n − 1, t, s, t, t, t, t, x),

t, t, t, t, x)

elseif rule (m,

prodn (tag ('statement, 's),

tag ('procedural statement, 's2)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'procedural statement),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('statement, 's),

tag ('procedure composition rule, 's2)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'procedure composition rule),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('statement, 's),

tag ('assert specification, 's2)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'assert specification),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('procedural statement, 's),
tag ('assignment statement, 's2)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'assignment statement),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('procedural statement, 's),
tag ('leave statement, 's2)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'leave statement),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('procedural statement, 's),
tag ('move statement, 's2)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'move statement),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('procedural statement, 's),
tag ('new statement, 's2)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'new statement),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('procedural statement, 's),
tag ('procedure statement, 's2)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'procedure statement),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('procedural statement, 's),
tag ('remove statement, 's2)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'remove statement),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('procedural statement, 's),
tag ('signal statement, 's2)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'signal statement),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('assignment statement, 's),
list (tag ('name expression, 'n),
'colon equal,
tag ('expression, 'e))))

then gp assign (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp parg, t, t, t, c, subtree (m,

       'name expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (m,

       'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

s, c, n, x)

elseif rule (m, prodn (tag ('leave statement, 's), 'leave)) then set condition (s, 'leave) elseif rule (m,

prodn (tag ('move statement, 's),

list ('move,

tag ('removable component, 'c),
tag ('component destination, 'd))))

then gp move (if remove exp arg (m) = nil then nil

else mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, remove exp arg (m), t, t, t, t, t, n − 1, t, s, t, t, t, t,

x) endif,

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp parg, t, t, t, c, remove name arg (m), t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

subtree (m, 'component destination),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp parg, t, t, t, c, new name arg (m), t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

c, s, n, x)

elseif rule (m,

prodn (tag ('new statement, 's),

list ('new,

tag ('expression, 'e),
tag ('new dynamic variable component,

'dc))))

then gp new (subtree (m, 'new dynamic variable component),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (m,

      'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp parg, t, t, t, c, new name arg (m), t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

c, s, n, x)

elseif rule (m,

prodn (tag ('procedure statement, 's),
list (tag ('identifier, 'pn),
tag ('arg list, 'dp),
tag ('opt actual condition parameters,

'cp))))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp procedure call, actual cargs (m), t, t, c, t, t, t, t, t, t, n − 1, gname (subtree (m,

'identifier)),

s, mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp parg list,

t, t, actual dargs (m), c, t, t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

t, t, t, x)

elseif rule (m,

prodn (tag ('remove statement, 's),
list ('remove,
tag ('removable component, 'c))))

then gp remove (if remove exp arg (m) = nil then nil

else mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, remove exp arg (m), t, t, t, t, t, n − 1, t, s, t, t, t, t,

x) endif,

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp parg, t, t, t, c, remove name arg (m), t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

c, s, n, x)

elseif rule (m,

prodn (tag ('signal statement, 's),
list ('signal, tag ('identifier, 'c))))

then if conditionp (gname (subtree (m, 'identifier)), s)

then set condition (s, gname (subtree (m, 'identifier))) else mark state indeterminate (s) endif

elseif rule (m,

prodn (tag ('procedure composition rule, 's),
tag ('if composition, 's2)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'if composition),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('procedure composition rule, 's),
tag ('case composition, 's2)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'case composition),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('procedure composition rule, 's),
tag ('loop composition, 's2)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'loop composition),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('procedure composition rule, 's),
tag ('begin composition, 's2)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'begin composition),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('if composition, 's),

list ('if,

tag ('expression, 'b),
'then,
tag ('opt internal statements, 'ss),
tag ('if composition else part,
'ep),
tag ('opt condition handlers, 'cs),
'end)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp cond, t, t, t, c, t, t, t, t, t, subtree (m,

'opt condition handlers),

n − 1, t, if normal state (gpf type check (boolean desc,

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (m,

       'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)))

then if gtruep (result˜ (gpf type check (boolean desc, mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf,

t, t, t, c, subtree (m,

       'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x))))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

'opt internal statements),

n − 1, t, s, t, t, t, t, x)

elseif if statement else part (m)

= nil then s else mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, if statement else part (m), n − 1, t, s, t, t, t, t,

x) endif

else gpf type check (boolean desc,

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (m,

               'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)) endif,

t, t, t, t, x) elseif rule (m,

prodn (tag ('case composition, 's),

list ('case,

tag ('expression, 'e),
tag ('case composition body, 'b),
tag ('opt condition handlers, 'c),
'end)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp cond, t, t, t, c, t, t, t, t, t, subtree (m,

'opt condition handlers),

n − 1, t, if normal state (gp case label check (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf,

t, t, t, c, subtree (m,

       'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf list, t, t, t, c, t, case labels (m), t, t, t, t, n − 1, t, s, t, t, t, t, x),

s))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp case body, t, t, t, c, t, t, t, t, mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf,

t, t, t, c, subtree (m,

                                                                                                                        'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

subtree (m,

'case composition body),

n − 1, t, s, t, t, t, t, x)

else gp case label check (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (m,

       'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf list, t, t, t, c, t, case labels (m), t, t, t, t, n − 1, t, s, t, t, t, t, x),

s) endif,

t, t, t, t, x)

elseif rule (m,

prodn (tag ('loop composition, 's),

list ('loop,

tag ('opt internal statements, 'ss),
tag ('opt condition handlers, 'c),
'end)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp cond, t, t, t, c, t, t, t, t, t, subtree (m,

       'opt condition handlers),

n − 1, t, if condition non normal (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp,

t, t, t, c, t, t, t, t, t, subtree (m,

     'opt internal statements),

n − 1, t, s, t, t, t, t, x))

then reset leave to normal (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'opt internal statements),

n − 1, t, s, t, t, t, t, x))

else mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, m, n − 1, t, mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp,

t, t, t, c, t, t, t, t, t, subtree (m,

       'opt internal statements),

n − 1, t, s, t, t, t, t, x),

t, t, t, t,

x) endif,

t, t, t, t, x)

elseif rule (m,

prodn (tag ('begin composition, 's),
list ('begin,
tag ('opt internal statements, 'ss),
tag ('opt condition handlers, 'c),
'end)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp cond, t, t, t, c, t, t, t, t, t, subtree (m,

'opt condition handlers),

n − 1, t, mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp,

t, t, t, c, t, t, t, t, t, subtree (m,

       'opt internal statements),

n − 1, t, s, t, t, t, t, x),

t, t, t, t, x)

elseif rule (m,

prodn (tag ('opt internal statements, 'ss),

'empty)) then s

elseif rule (m,

prodn (tag ('opt internal statements, 'ss),
list (tag ('statement list, 'ss2),
'opt semi colon)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'statement list),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('opt internal statements, 'ss),
'(pending opt semi colon)))

then mark state indeterminate (s) elseif rule (m,

prodn (tag ('assert specification, 's),
list ('assert,
tag ('specification expression, 'e))))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'specification expression),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('specification expression, 'e),
tag ('non validated specification expression,
'e2)))

then gp update assert (expression from spec (m), c, s, n, x) elseif rule (m,

prodn (tag ('specification expression, 'e),
tag ('validated specification expression,
'e2)))

∨ rule (m,

prodn (tag ('specification expression,
'e),
list ('open paren,
tag ('validated specification expression,
'e2),
'close paren)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'validated specification expression),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('validated specification expression,
'e),
list (tag ('non validated specification expression,
'e2),
'otherwise,
tag ('identifier, 'i))))

then if normal state (gpf type check (boolean desc,

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, expression from spec (m), t, t, t, t, t, n − 1, t, s, t, t, t, t, x)))

then if gtruep (result˜ (gpf type check (boolean desc,

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, expression from spec (m), t, t, t, t, t, n − 1, t, s, t, t, t, t, x))))

then gp record assert (result˜ (gpf type check (boolean desc,

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, expression from spec (m), t, t, t, t, t, n − 1, t, s, t, t, t, t, x))),

s)

else mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, mk signal stmt (subtree (m,

'identifier)),

n − 1, t, gp record assert (result˜ (gpf type check (boolean desc,

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, expression from spec (m), t, t, t, t, t, n − 1, t, s, t, t, t, t, x))),

s),

t, t, t, t,

x) endif

else gpf type check (boolean desc,

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, expression from spec (m), t, t, t, t, t, n − 1, t, s, t, t, t, t, x)) endif

else mark state indeterminate (s) endif case = gp cond then if indeterminate (s) ∨ condition normal (s) then s

elseif (n ≃ 0)

∨ (¬ condition labels ok (handler labels (m), s)) then mark state indeterminate (s) elseif handler (m, cond˜ (s)) = nil then s else mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp,

t, t, t, c, t, t, t, t, t, handler (m,

cond˜ (s)), n − 1, t, set condition (s,

           'normal),

t, t, t, t,

x) endif

case = gp case body then if ¬ normal state (s) then s

elseif fix (n) ≃ 0 then mark state indeterminate (s) elseif rule (m,

prodn (tag ('case composition body, 'b),

'empty)) then s

elseif rule (m,

prodn (tag ('case composition body, 'b),

list ('else,

'colon,
tag ('opt internal statements,

'ss))))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'opt internal statements),

n − 1, t, s, t, t, t, t, x) elseif rule (m,

prodn (tag ('case composition body, 'b),

list ('is,

tag ('case labels, 'cs),
'colon,
tag ('opt internal statements,
'ss),
tag ('case composition body, 'b2))))

then if normal state (gpf gin (k,

gpf gset (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf list, t, t, t, c, t, case labels (m), t, t, t, t, n − 1, t, s, t, t, t, t, x),

base type (type (result˜ (k))), s),

s))

then if gtruep (result˜ (gpf gin (k,

gpf gset (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf list, t, t, t, c, t, case labels (m), t, t, t, t, n − 1, t, s, t, t, t, t, x),

base type (type (result˜ (k))), s),

s)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'opt internal statements),

n − 1, t, s, t, t, t, t, x)

else mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp case body, t, t, t, c, t, t, t, t, k, subtree (m,

      'case composition body),

n − 1, t, s, t, t, t, t,

x) endif

else gpf gin (k,

gpf gset (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf list, t, t, t, c, t, case labels (m), t, t, t, t, n − 1, t, s, t, t, t, t, x),

base type (type (result˜ (k))), s),

s) endif

else mark state indeterminate (s) endif case = gp locals then if ¬ normal state (s) then s

elseif n ≃ 0 then mark state indeterminate (s) elseif rule (m,

prodn (tag ('opt internal environment, 'iv),

'empty)) then s

elseif rule (m,

prodn (tag ('opt internal environment, 'iv),
tag ('internal environment, 'iv2)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp locals, t, t, t, c, t, t, t, t, t, subtree (m,

       'internal environment),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('internal environment, 'iv),
tag ('internal data or condition objects,
'iv2)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp locals, t, t, t, c, t, t, t, t, t, subtree (m,

       'internal data or condition objects),

n − 1, t, s, t, t, t, t, x)

elseif rule (m,

prodn (tag ('internal environment, 'iv),
list (tag ('internal environment, 'iv2),
tag ('internal data or condition objects,
'iv3))))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp locals, t, t, t, c, t, t, t, t, t, subtree (m,

       'internal data or condition objects),

n − 1, t, mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp locals,

t, t, t, c, t, t, t, t, t, subtree (m,

                                                                                                                        'internal environment),

n − 1, t, s, t, t, t, t, x),

t, t, t, t, x)

elseif rule (m,

prodn (tag ('internal data or condition objects,
'iv),
list (tag ('access specification, 'a),
tag ('identifier list, 'is),

'colon,
tag ('type specification, 'ts),
tag ('opt internal initial value,
'v),
'semi colon)))

then gp bind locals (access (m), id list (subtree (m, 'identifier list)), type desc (subtree (m,

'type specification),

c, nil, x),

if internal initial value exp (m) = nil then internal initial value exp (m) else mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf,

t, t, t, c, internal initial value exp (m), t, t, t, t, t, n − 1, t, s, t, t, t, t,

x) endif,

s)

elseif rule (m,

prodn (tag ('internal data or condition objects,
'iv),

list ('cond,

tag ('identifier list, 'is),
'semi colon)))

then gp local conds (id list (subtree (m, 'identifier list)),

s)

else mark state indeterminate (s) endif case = gp procedure body then if fix (n) ≃ 0 then mark state indeterminate (s)

elseif rule (m, prodn (tag ('procedure body, 'b), 'pending)) then mark state indeterminate (s) elseif rule (m,

prodn (tag ('procedure body, 'b),
list ('begin,
tag ('external operational specification,
'es),
tag ('opt internal environment,
'iv),
tag ('opt keep specification, 'k),
tag ('opt internal statements,
'st),
'end)))

then if indeterminate (gp deallocate locals (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'opt internal statements),

n − 1, t, gp set keep (keep spec (m),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp locals, t, t, t, c, t, t, t, t, t, subtree (m,

                                                                                                                        'opt internal environment),

n − 1, t, gp set entry (prec (m), s, n, x),

t, t, t, t, x),

c, n, x),

t, t, t, t, x)))

then gp deallocate locals (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'opt internal statements),

n − 1, t, gp set keep (keep spec (m),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp locals, t, t, t, c, t, t, t, t, t, subtree (m,

                                                                                                                        'opt internal environment),

n − 1, t, gp set entry (prec (m),

c, s, n, x),

t, t, t, t, x),

c, n, x),

t, t, t, t, x))

elseif (cond˜ (gp deallocate locals (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'opt internal statements),

n − 1, t, gp set keep (keep spec (m),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp locals, t, t, t, c, t, t, t, t, t, subtree (m,

                                                                                                                        'opt internal environment),

n − 1, t, gp set entry (prec (m),

c, s, n, x),

t, t, t, t, x),

c, n, x),

t, t, t, t, x)))

= 'normal)

∨ conditionp (cond˜ (gp deallocate locals (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

       'opt internal statements),

n − 1, t, gp set keep (keep spec (m),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp locals, t, t, t, c, t, t, t, t, t, subtree (m,

       'opt internal environment),

n − 1, t, gp set entry (prec (m),

c, s, n, x),

t, t, t, t, x),

c, n, x),

t, t, t, t, x))),

gp deallocate locals (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

'opt internal statements),

n − 1, t, gp set keep (keep spec (m),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp locals, t, t, t, c, t, t, t, t, t, subtree (m,

       'opt internal environment),

n − 1, t, gp set entry (prec (m),

c, s, n, x),

t, t, t, t, x),

c, n, x),

t, t, t, t, x)))

then gp set exit (exit spec (m), c, gp deallocate locals (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp,

t, t, t, c, t, t, t, t, t, subtree (m,

'opt internal statements),

n − 1, t, gp set keep (keep spec (m),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp locals, t, t, t, c, t, t, t, t, t, subtree (m,

       'opt internal environment),

n − 1, t, gp set entry (prec (m),

c, s, n, x),

t, t, t, t, x),

c, n, x),

t, t, t, t, x)),

n, x)

elseif cond˜ (gp deallocate locals (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

'opt internal statements),

n − 1, t, gp set keep (keep spec (m),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp locals, t, t, t, c, t, t, t, t, t, subtree (m,

       'opt internal environment),

n − 1, t, gp set entry (prec (m),

c, s, n, x),

t, t, t, t, x),

c, n, x),

t, t, t, t, x)))

= 'leave

then set condition (gp deallocate locals (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

'opt internal statements),

n − 1, t, gp set keep (keep spec (m),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp locals, t, t, t, c, t, t, t, t, t, subtree (m,

       'opt internal environment),

n − 1, t, gp set entry (prec (m),

c, s, n, x),

t, t, t, t, x),

c, n, x),

t, t, t, t, x)),

'routineerror)

else mark state indeterminate (gp deallocate locals (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp, t, t, t, c, t, t, t, t, t, subtree (m,

'opt internal statements),

n − 1, t, gp set keep (keep spec (m),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp locals, t, t, t, c, t, t, t, t, t, subtree (m,

       'opt internal environment),

n − 1, t, gp set entry (prec (m),

c, s, n, x),

t, t, t, t, x),

c, n, x),

t, t, t, t, x))) endif

else mark state indeterminate (s) endif case = gp procedure call then if fix (n) ≃ 0 then mark state indeterminate (s)

elseif (kind (cdr (ref (pn, c, x))) = 'procedure)

∨ (kind (cdr (ref (pn, c, x))) = 'function) then if normal state (gp call state (cdr (ref (pn, c, x)),

car (ref (pn, c, x)), sadp, acp, s, x))

then gp map call effects (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp procedure body, t, t, t, car (ref (pn,

c, x)),

t, t, t, t, t, procedure body (cdr (ref (pn,

c, x))),

n − 1, t, gp call state (cdr (ref (pn,

c, x)),

car (ref (pn, c, x)),

sadp, acp, s, x),

t, t, t, t, x),

cdr (ref (pn, c, x)), result˜ list (sadp), acp, c, s, n, x)

else map cond effects (cond˜ (gp call state (cdr (ref (pn, c, x)),

car (ref (pn, c, x)),

sadp, acp, s, x)),

formal cargs (cdr (ref (pn, c, x))), acp, marked (mark (gp call state (cdr (ref (pn,

c, x)),

car (ref (pn, c, x)),

sadp, acp, s, x)),

map (s))) endif

else set condition (s, 'routineerror) endif case = gp parg list then if as ≃ nil then nil

elseif fix (n) ≃ 0 then list (mark state indeterminate (s)) else cons (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp parg,

t, t, t, c, car (as), t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp parg list, t, t, cdr (as), c, t, t, t, t, t, t, n − 1, t, s, t, t, t, t, x)) endif

case = gp parg then if fix (n) ≃ 0 then mark state indeterminate (s)

elseif rule (mk name expression (e),

prodn (tag ('name expression, 'e),
tag ('identifier, 'i)))

then if normal state (gpf apply var (gname (subtree (mk name expression (e),

'identifier)),

s, nil))

then allocate ('result~,

name exp (gname (subtree (mk name expression (e),

'identifier)),

nil),

s)

else gpf apply var (gname (subtree (mk name expression (e),

'identifier)),

s, nil) endif

elseif rule (mk name expression (e),

prodn (tag ('name expression, 'e),
list (tag ('identifier, 'i),
tag ('selector list, 'ss))))

then if normal state (gpf apply var (gname (subtree (mk name expression (e),

'identifier)),

s, mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors,

t, t, t, c, subtree (mk name expression (e),

       'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)))

then allocate ('result~,

name exp (gname (subtree (mk name expression (e),

'identifier)),

result˜ list (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (mk name expression (e),

             'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x))),

s)

else gpf apply var (gname (subtree (mk name expression (e),

'identifier)),

s, mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors,

t, t, t, c, subtree (mk name expression (e),

       'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)) endif

else mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, e, t, t, t, t, t, n − 1, t, s, t, t, t, t,

x) endif

case = gpf then if ¬ normal state (s) then s

elseif fix (n) ≃ 0 then mark state indeterminate (s) elseif rule (e,

prodn (tag ('expression, 'e),
tag ('modified primary value, 'm)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

       'modified primary value),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('expression, 'e),
list ('all, tag ('bound expression, 'b))))

then if normal state (gpf bound values (e, c, s, x))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf all, t, t, t, c, cdr quantified exp (e), t, t, bound id (subtree (e,

                'bound expression)),

t, t, n − 1, t, s, t, t, t, result˜ (gpf bound values (e,

c, s, x)),

x)

else gpf bound values (e, c, s, x) endif elseif rule (e,

prodn (tag ('expression, 'e),
list ('some, tag ('bound expression, 'b))))

then if normal state (gpf bound values (e, c, s, x))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf some, t, t, t, c, cdr quantified exp (e), t, t, bound id (subtree (e,

                'bound expression)),

t, t, n − 1, t, s, t, t, t, result˜ (gpf bound values (e,

c, s, x)),

x)

else gpf bound values (e, c, s, x) endif elseif rule (e,

prodn (tag ('expression, 'e),
list (tag ('unary operator, 'op),
tag ('expression, 'e2))))

then gpf apply unary op (subtree (e, 'unary operator),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

       'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

s)

elseif rule (e,

prodn (tag ('expression, 'e),
list (tag ('expression, 'e1),
tag ('binary operator, 'op),
tag ('expression, 'e2))))

then gpf apply binary op (subtree (e, 'binary operator),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree i (e,

         'expression,

1), t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree i (e,

        'expression,

2),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

s)

elseif rule (e,

prodn (tag ('modified primary value, 'm),
tag ('primary value, 'p)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

'primary value),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('modified primary value, 'm),
list (tag ('modified primary value, 'm2),
tag ('value modifiers, 'vm))))

then if fn call formp (e)

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf apply, nil, mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf adp,

t, t, t, c, arg list (subtree (e,

              'value modifiers)),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

t, t, t, t, object name (subtree (e,

                   'modified primary value)),

t, t, t, n − 1, t, s, t, t, c, t, x)

else mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf modifiers, t, t, t, c, subtree (e,

       'value modifiers),

t, t, t, t, t, n − 1, t, s, t, mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf,

t, t, t, c, subtree (e,

                                                                                                                        'modified primary value),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

t, t,

x) endif

elseif rule (e,

prodn (tag ('modified primary value, 'm),
list (tag ('modified primary value, 'm2),
tag ('actual condition parameters,

'cp))))

then if fn call formp (e)

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf apply, actual cargs (e), mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf adp,

t, t, t, c, arg list (subtree (e,

              'modified primary value)),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

t, t, t, t, object name (subtree (e,

'modified primary value)),

t, t, t, n − 1, t, s, t, t, c, t, x)

else set condition (s, 'routineerror) endif elseif rule (e,

prodn (tag ('primary value, 'p),
tag ('literal value, 'l)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

       'literal value),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('primary value, 'p),
tag ('set or sequence value, 's)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

       'set or sequence value),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('primary value, 'p),
tag ('entry value, 'e)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

       'entry value),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('primary value, 'p),
tag ('identifier, 'on)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

       'identifier),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('primary value, 'p),
tag ('if expression, 'i)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

       'if expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('primary value, 'p),
list ('open paren,
tag ('expression, 'e),
'close paren)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

       'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('constant body, 'b),
tag ('expression, 'e)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

       'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e, prodn (tag ('constant body, 'b), 'pending)) then mark state indeterminate (s) elseif rule (e,

prodn (tag ('if expression, 'i),

list ('if,

tag ('expression, 'b),
'then,
tag ('expression, 'p),
tag ('if expression else part, 'e))))

then if ¬ normal state (gpf type check (boolean desc,

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree i (e,

        'expression,

1),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)))

then gpf type check (boolean desc,

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree i (e,

'expression,

1),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x))

elseif gtruep (result˜ (gpf type check (boolean desc,

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree i (e,

        'expression,

1),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x))))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree i (e,

'expression,

2),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

else mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, if else exp (subtree (e,

                 'if expression else part)),

t, t, t, t, t, n − 1, t, s, t, t, t, t,

x) endif

elseif rule (e,

prodn (tag ('literal value, 'l),
tag ('character value, 'ch)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

   'character value),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('literal value, 'l),
tag ('number, 'n)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

       'number),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('literal value, 'l),
tag ('string value, 's)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

       'string value),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('number, 'n), tag ('digit list, 's)))

then gpf minteger (e, s) elseif rule (e,

prodn (tag ('number, 'n),

list (tag ('base, 'b), tag ('digit list, 's))))

then gpf minteger (e, s) elseif rule (e,

prodn (tag ('pre computable label expression,
'p),
tag ('number, 'n)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

       'number),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('pre computable label expression,
'p),
list ('minus, tag ('number, 'n))))

then gpf apply unary op (mk unary operator ('minus), mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

       'number),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

s)

elseif rule (e,

prodn (tag ('pre computable label expression,
'p),
tag ('character value, 'ch)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

'character value),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x) elseif rule (e,

prodn (tag ('pre computable label expression,
'p),
tag ('identifier, 'i)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

       'identifier),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('set or sequence value, 's),
list ('open paren,
tag ('set or seq mark, 'm),
tag ('element list, 'e),
'close paren)))

then gpf gset or seq (subtree (e, 'set or seq mark),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf element list, t, t, t, c, subtree (e,

                    'element list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf element type, t, t, t, c, subtree (e,

       'element list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

s)

elseif rule (e,

prodn (tag ('set or sequence value, 's),
tag ('range, 'r)))

then gpf gset or seq (nil,

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf element list, t, t, t, c, subtree (e,

       'range),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf element type, t, t, t, c, subtree (e,

       'range),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

s)

elseif character valuep (e) then gpf gchar (e, s) elseif digit listp (e) then gpf minteger (e, s) elseif entry valuep (e) then gpf apply var (entry name (e), s, nil) elseif identifierp (e) then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf apply,

nil, nil, t, t, t, t, gname (e), t, t, t, n − 1, t, s, t, t, c, t, x)

elseif string valuep (e) then gpf gstring seq (e, s) else mark state indeterminate (s) endif

case = gpf list then if es ≃ nil then nil

elseif fix (n) ≃ 0 then list (mark state indeterminate (s)) else cons (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf,

t, t, t, c, car (es), t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf list, t, t, t, c, t, cdr (es), t, t, t, t, n − 1, t, s, t, t, t, t, x)) endif

case = gpf apply then if state componentp (fn, s)

then if acp = nil then gpf apply var (fn, s, adp)

else set condition (s, 'routineerror) endif elseif fn = 'false then if acp = nil then gpf select op (gpf false (s), adp, s)

else set condition (s, 'routineerror) endif elseif fn = 'true then if acp = nil then gpf select op (gpf true (s), adp, s)

else set condition (s, 'routineerror) endif elseif type name expp (fn, adp, sn, x) then if acp = nil then gpf type name arg (fn, sn, s, x)

else set condition (s, 'routineerror) endif elseif fn = 'domain then if acp = nil then gpf std domain (adp, s)

else set condition (s, 'routineerror) endif elseif fn = 'first then if acp = nil then gpf std first (adp, s)

else set condition (s, 'routineerror) endif elseif fn = 'initial then if acp = nil then gpf std initial (adp, s)

else set condition (s, 'routineerror) endif elseif fn = 'last then if acp = nil then gpf std last (adp, s)

else set condition (s, 'routineerror) endif elseif fn = 'lower then if acp = nil then gpf std lower (adp, s)

else set condition (s, 'routineerror) endif elseif fn = 'max then if acp = nil then gpf std max (adp, s)

else set condition (s, 'routineerror) endif elseif fn = 'min then if acp = nil then gpf std min (adp, s)

else set condition (s, 'routineerror) endif

elseif fn = 'nonfirst

then if acp = nil then gpf std nonfirst (adp, s)

else set condition (s, 'routineerror) endif elseif fn = 'nonlast then if acp = nil then gpf std nonlast (adp, s)

else set condition (s, 'routineerror) endif elseif fn = 'null then if acp = nil then gpf std null (adp, s)

else set condition (s, 'routineerror) endif elseif fn = 'ord then if acp = nil then gpf std ord (adp, s)

else set condition (s, 'routineerror) endif elseif fn = 'pred then if acp = nil then gpf std pred (adp, s)

else set condition (s, 'routineerror) endif elseif fn = 'range then if acp = nil then gpf std range (adp, s)

else set condition (s, 'routineerror) endif elseif fn = 'scale then if acp = nil then gpf std scale (adp, s)

else set condition (s, 'routineerror) endif elseif fn = 'size then if acp = nil then gpf std size (adp, s)

else set condition (s, 'routineerror) endif elseif fn = 'succ then if acp = nil then gpf std succ (adp, s)

else set condition (s, 'routineerror) endif elseif fn = 'upper then if acp = nil then gpf std upper (adp, s)

else set condition (s, 'routineerror) endif elseif fix (n) ≃ 0 then mark state indeterminate (s) else mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf apply fun,

acp, adp, t, t, t, t, fn, t, t, t, n − 1, t, s, t, t, sn, t,

x) endif

case = gpf apply fun then if fix (n) ≃ 0 then mark state indeterminate (s)

elseif kind (cdr (ref (fn, sn, x))) = 'function then gpf select op (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp procedure call,

acp, t, t, sn, t, t, t, t, t, t, n − 1, fn, s, if length (formal dargs (cdr (ref (fn,

sn, x))))

  = 0

then nil else adp endif, t, t, t, x),

if length (formal dargs (cdr (ref (fn, sn, x))))

= 0 then adp else nil endif, s)

elseif kind (cdr (ref (fn, sn, x))) = 'constant then if acp = nil

then gpf select op (gpf retype result˜ (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, car (ref (fn,

sn, x)),

constant body (cdr (ref (fn, sn, x))),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

type desc (result type (cdr (ref (fn, sn, x))),

car (ref (fn, sn, x)),

nil, x)),

adp, s)

else set condition (s, 'routineerror) endif else set condition (s, 'routineerror) endif

case = gpf modifiers then if ¬ normal state (s) then s

elseif ¬ normal state (sbv) then sbv elseif fix (n) ≃ 0 then mark state indeterminate (s) elseif rule (e,

prodn (tag ('value modifiers, 'm),
tag ('component selectors, 's)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf modifiers, t, t, t, c, subtree (e,

'component selectors),

t, t, t, t, t, n − 1, t, s, t, sbv, t, t, x)

elseif rule (e,

prodn (tag ('component selectors, 's),
list ('dot, tag ('identifier, 'fn))))

then gpf record get (sbv,

allocate ('result~,

marked ('field name,

gname (subtree (e,

'identifier))),

s), s)

elseif rule (e,

prodn (tag ('component selectors, 's),
tag ('arg list, 'd)))

then gpf select op (sbv,

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf adp, t, t, t, c, subtree (e,

       'arg list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

s)

elseif rule (e,

prodn (tag ('value modifiers, 'm),
tag ('range, 'r)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf modifiers, t, t, t, c, subtree (e,

       'range),

t, t, t, t, t, n − 1, t, s, t, sbv, t, t, x)

elseif rule (e,

prodn (tag ('range, 'r),

list ('open paren,
tag ('range limits, 'r2),
'close paren)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf modifiers, t, t, t, c, subtree (e,

       'range limits),

t, t, t, t, t, n − 1, t, s, t, sbv, t, t, x)

elseif rule (e,

prodn (tag ('range limits, 'r),
list (tag ('expression, 'lo),
'dot dot,
tag ('expression, 'hi))))

then gpf subsequence get (sbv,

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree i (e,

        'expression,

1),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree i (e,

        'expression,

2),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

s)

elseif rule (e,

prodn (tag ('value modifiers, 'm),
tag ('value alterations, 'a)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf modifiers, t, t, t, c, subtree (e,

       'value alterations),

t, t, t, t, t, n − 1, t, s, t, sbv, t, t, x)

elseif rule (e,

prodn (tag ('value alterations, 'a),

list ('with,

'open paren,
tag ('component alterations list,
'al),
'close paren)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf modifiers, t, t, t, subtree (e,

       'component alterations list),

t, t, t, t, t, n − 1, t, s, t, sbv, t, t, x)

elseif rule (e,

prodn (tag ('component alterations list, 'al),
tag ('component alterations, 'a)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf modifiers, t, t, t, c, subtree (e,

       'component alterations),

t, t, t, t, t, n − 1, t, s, t, sbv, t, t, x)

elseif rule (e,

prodn (tag ('component alterations list, 'al),
list (tag ('component alterations list,
'al2),
'semi colon,

tag ('component alterations, 'a))))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf modifiers, t, t, t, c, subtree (e,

       'component alterations),

t, t, t, t, t, n − 1, t, s, t, mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf modifiers,

t, t, t, c, subtree (e,

                                                                                                                        'component alterations list),

t, t, t, t, t, n − 1, t, s, t, sbv, t, t, x),

t, t, x)

elseif rule (e,

prodn (tag ('component alterations, 'as),
list (tag ('opt each clause, 'e),
tag ('component assignment, 'a))))

then if each clausep (subtree (e, 'opt each clause))

then if normal state (gpf bound values (subtree (e,

'opt each clause),

c, s, x))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf each, t, t, t, c, subtree (e,

       'component assignment),

t, t, bound id (subtree (e,

                'opt each clause)),

t, t, n − 1, t, s, t, sbv, t, result˜ (gpf bound values (subtree (e,

                             'opt each clause),

c, s, x)),

x)

else gpf bound values (subtree (e,

'opt each clause),

c, s,

x) endif

else mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf modifiers, t, t, t, c, subtree (e,

 'component assignment),

t, t, t, t, t, n − 1, t, s, t, sbv, t, t,

x) endif

elseif rule (e,

prodn (tag ('component alterations, 'as),
list (tag ('opt each clause, 'e),
tag ('component creation, 'c))))

then if each clausep (subtree (e, 'opt each clause))

then if normal state (gpf bound values (subtree (e,

'opt each clause),

c, s, x))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf each, t, t, t, c, subtree (e,

       'component creation),

t, t, bound id (subtree (e,

                'opt each clause)),

t, t, n − 1, t, s, t, sbv, t, result˜ (gpf bound values (subtree (e,

                             'opt each clause),

c, s, x)),

x)

else gpf bound values (subtree (e,

'opt each clause),

c, s,

x) endif

else mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf modifiers, t, t, t, c, subtree (e,

       'component creation),

t, t, t, t, t, n − 1, t, s, t, sbv, t, t,

x) endif

elseif rule (e,

prodn (tag ('component alterations, 'as),
list (tag ('opt each clause, 'e),
tag ('component deletion, 'd))))

then if each clausep (subtree (e, 'opt each clause))

then if normal state (gpf bound values (subtree (e,

'opt each clause),

c, s, x))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf each, t, t, t, c, subtree (e,

             'component deletion),

t, t, bound id (subtree (e,

                      'opt each clause)),

t, t, n − 1, t, s, t, sbv, t, result˜ (gpf bound values (subtree (e,

                                   'opt each clause),

c, s, x)),

x)

else gpf bound values (subtree (e,

'opt each clause),

c, s,

x) endif

else mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf modifiers, t, t, t, c, subtree (e,

       'component deletion),

t, t, t, t, t, n − 1, t, s, t, sbv, t, t,

x) endif elseif rule (e,

prodn (tag ('component assignment, 'a),
list (tag ('selector list, 's),
'colon equal,
tag ('expression, 'e))))

then gpf put op (sbv,

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (e,

       'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

       'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

s)

elseif rule (e,

prodn (tag ('component creation, 'c),
list ('before,
tag ('selector list, 's),
'colon equal,
tag ('expression, 'e))))

then gpf put op (sbv,

rcdr (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (e,

       'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)),

gpf gseq insert before (gpf select op (sbv,

rcdr (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (e,

                                      'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)),

s),

rcar (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (e,

       'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

   'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

s),

s)

elseif rule (e,

prodn (tag ('component creation, 'c),
list ('behind,
tag ('selector list, 's),
'colon equal,
tag ('expression, 'e))))

then gpf put op (sbv,

rcdr (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (e,

       'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)),

gpf gseq insert behind (gpf select op (sbv,

rcdr (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (e,

                                      'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)),

s),

rcar (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (e,

       'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

   'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

s),

s)

elseif rule (e,

prodn (tag ('component creation, 'c),

list ('into,

tag ('selector list, 's),
'colon equal,
tag ('expression, 'e))))

then gpf put op (sbv,

rcdr (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (e,

       'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)),

gpf gmap insert (gpf select op (sbv,

rcdr (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (e,

                                 'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)),

s),

rcar (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (e,

       'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

   'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

s),

s)

elseif rule (e,

prodn (tag ('component deletion, 'd),
list ('seqomit, tag ('selector list, 's))))

then gpf put op (sbv,

rcdr (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (e,

       'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)),

gpf gseqomit (gpf select op (sbv,

rcdr (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (e,

                              'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)),

s),

rcar (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (e,

       'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)),

s),

s)

elseif rule (e,

prodn (tag ('component deletion, 'd),
list ('mapomit, tag ('selector list, 's))))

then gpf put op (sbv,

rcdr (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, subtree (e,

'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)),

gpf gmapomit (gpf select op (sbv,

rcdr (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (e,

       'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)),

s),

rcar (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (e,

                                  'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)),

s),

s)

else mark state indeterminate (s) endif case = gpf selectors then if ¬ normal state (s) then list (s)

elseif fix (n) ≃ 0 then list (mark state indeterminate (s)) elseif rule (e,

prodn (tag ('selector list, 's),
tag ('component selectors, 's2)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (e,

       'component selectors),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('selector list, 's),
list (tag ('selector list, 's2),
tag ('component selectors, 's3))))

then append (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (e,

       'selector list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors, t, t, t, c, subtree (e,

       'component selectors),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x))

elseif rule (e,

prodn (tag ('component selectors, 's),
list ('dot, tag ('identifier, 'fn))))

then list (allocate ('result~,

marked ('field name,

gname (subtree (e, 'identifier))), s))

elseif rule (e,

prodn (tag ('component selectors, 's),
tag ('arg list, 'd)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf adp, t, t, t, c, subtree (e,

       'arg list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('arg list, 'as),

list ('open paren,
tag ('value list, 'vs),
'close paren)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf adp, t, t, t, c, subtree (e,

       'value list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

else list (mark state indeterminate (s)) endif case = gpf adp then if ¬ normal state (s) then list (s)

elseif fix (n) ≃ 0 then list (mark state indeterminate (s)) elseif rule (e,

prodn (tag ('arg list, 'as),

list ('open paren,
tag ('value list, 'vs),
'close paren)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf adp, t, t, t, c, subtree (e,

       'value list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('value list, 'vs),
tag ('expression, 'e)))

then rcons (nil, mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

       'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x))

elseif rule (e,

prodn (tag ('value list, 'vs),
list (tag ('value list, 'vs2),
'comma,
tag ('expression, 'e))))

then rcons (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf adp, t, t, t, c, subtree (e,

       'value list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x), mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf,

t, t, t, c, subtree (e,

       'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x))

else list (mark state indeterminate (s)) endif case = gpf each then if ¬ normal state (s) then s

elseif vs ≃ nil then sbv elseif gp new namep (id, s) then if n ≃ 0 then mark state indeterminate (s)

else mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf each, t, t, t, c, e, t, t, id, t, t, n − 1, t, s, t, mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf modifiers,

t, t, t, c, e, t, t, t, t, t, n − 1, t, allocate const (id,

car (vs),

            'local,

s),

t, sbv, t, t, x),

t, cdr (vs),

x) endif

else set condition (s, 'routineerror) endif case = gpf some then if vs ≃ nil then gpf false (s)

elseif gp new namep (id, s) then if n ≃ 0 then mark state indeterminate (s)

else gpf gor (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf some, t, t, t, c, e, t, t, id, t, t, n − 1, t, s, t, t, t, rcdr (vs), x),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, e, t, t, t, t, t, n − 1, t, allocate const (id,

rcar (vs),

            'local,

s),

t, t, t, t, x),

s) endif

else set condition (s, 'routineerror) endif case = gpf all then if vs ≃ nil then gpf true (s)

elseif gp new namep (id, s) then if n ≃ 0 then mark state indeterminate (s)

else gpf gand (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf all, t, t, t, c, e, t, t, id, t, t, n − 1, t, s, t, t, t, rcdr (vs), x),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, e, t, t, t, t, t, n − 1, t, allocate const (id,

rcar (vs),

             'local,

s),

t, t, t, t, x),

s) endif

else set condition (s, 'routineerror) endif case = gpf element type then if fix (n) ≃ 0 then mark state indeterminate (s)

elseif rule (e,

prodn (tag ('range, 'r),

list ('open paren,
tag ('range limits, 'r2),
'close paren)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf element type, t, t, t, c, subtree (e,

'range limits),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('element list, 'e),
tag ('value list, 'v)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf element type, t, t, t, c, subtree (e,

       'value list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('element list, 'e),
tag ('range limits, 'r)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf element type, t, t, t, c, subtree (e,

'range limits),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('range limits, 'r),
list (tag ('expression, 'lo),
'dot dot,
tag ('expression, 'hi))))

then base type (type (result˜ (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree i (e,

        'expression,

1),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x))))

elseif rule (e,

prodn (tag ('value list, 'v),

tag ('expression, 'e)))

then base type (type (result˜ (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

       'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x))))

elseif rule (e,

prodn (tag ('value list, 'v),

list (tag ('value list, 'v2),
'comma,
tag ('expression, 'e))))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf element type, t, t, t, c, subtree (e,

'value list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

else nil endif otherwise if ¬ normal state (s) then list (s)

elseif fix (n) ≃ 0 then list (mark state indeterminate (s)) elseif rule (e,

prodn (tag ('range, 'r),

list ('open paren,
tag ('range limits, 'r2),
'close paren)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf element list, t, t, t, c, subtree (e,

       'range limits),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('element list, 'e),
tag ('value list, 'v)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf element list, t, t, t, c, subtree (e,

       'value list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('element list, 'e),
tag ('range limits, 'r)))

then mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf element list, t, t, t, c, subtree (e,

       'range limits),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x)

elseif rule (e,

prodn (tag ('range limits, 'r),
list (tag ('expression, 'lo),
'dot dot,
tag ('expression, 'hi))))

then gpf grange elements (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree i (e,

                          'expression,

1),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree i (e,

        'expression,

2),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

s)

elseif rule (e,

prodn (tag ('value list, 'v),

tag ('expression, 'e)))

then rcons (nil,

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

       'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x))

elseif rule (e,

prodn (tag ('value list, 'v),

list (tag ('value list, 'v2),
'comma,
tag ('expression, 'e))))

then rcons (mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf element list, t, t, t, c, subtree (e,

       'value list),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x),

mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf, t, t, t, c, subtree (e,

                           'expression),

t, t, t, t, t, n − 1, t, s, t, t, t, t, x))

else list (mark state indeterminate (s)) endif endcase

Definition: gp (m, c, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp,

t, t, t, c, t, t, t, t, t, m, n, t, s, t, t, t, t, x)

Definition: gp cond (m, c, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp cond,

t, t, t, c, t, t, t, t, t, m, n, t, s, t, t, t, t, x)

Definition: gp case body (k, m, c, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp case body,

t, t, t, c, t, t, t, t, k, m, n, t, s, t, t, t, t, x)

Definition: gp locals (m, c, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp locals,

t, t, t, c, t, t, t, t, t, m, n, t, s, t, t, t, t, x)

Definition: gp procedure body (m, c, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp procedure body,

t, t, t, c, t, t, t, t, t, m, n, t, s, t, t, t, t, x)

Definition: gp procedure call (pn, sadp, acp, c, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp procedure call,

acp, t, t, c, t, t, t, t, t, t, n, pn, s, sadp, t, t, t, x)

Definition: gp parg list (as, c, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp parg list,

t, t, as, c, t, t, t, t, t, t, n, t, s, t, t, t, t, x)

Definition: gp parg (e, c, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gp parg,

t, t, t, c, e, t, t, t, t, t, n, t, s, t, t, t, t, x)

Definition: gpf (e, c, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf,

t, t, t, c, e, t, t, t, t, t, n, t, s, t, t, t, t, x)

Definition: gpf list (es, c, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf list,

t, t, t, c, t, es, t, t, t, t, n, t, s, t, t, t, t, x)

Definition: gpf apply (fn, adp, acp, sn, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf apply,

acp, adp, t, t, t, t, fn, t, t, t, n, t, s, t, t, sn, t, x)

Definition: gpf apply fun (fn, adp, acp, sn, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf apply fun,

acp, adp, t, t, t, t, fn, t, t, t, n, t, s, t, t, sn, t, x)

Definition: gpf modifiers (sbv, e, c, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf modifiers,

t, t, t, c, e, t, t, t, t, t, n, t, s, t, sbv, t, t, x)

Definition: gpf selectors (e, c, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf selectors,

t, t, t, c, e, t, t, t, t, t, n, t, s, t, t, t, t, x)

Definition: gpf adp (e, c, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf adp,

t, t, t, c, e, t, t, t, t, t, n, t, s, t, t, t, t, x)

Definition: gpf each (id, vs, sbv, e, c, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf each,

t, t, t, c, e, t, t, id, t, t, n, t, s, t, sbv, t, vs, x)

Definition: gpf some (id, vs, e, c, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf some,

t, t, t, c, e, t, t, id, t, t, n, t, s, t, t, t, vs, x)

Definition: gpf all (id, vs, e, c, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf all,

t, t, t, c, e, t, t, id, t, t, n, t, s, t, t, t, vs, x)

Definition: gpf element type (e, c, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf element type,

t, t, t, c, e, t, t, t, t, t, n, t, s, t, t, t, t, x)

Definition: gpf element list (e, c, s, n, x) = mutual-gp-gp cond-gp case body-gp locals-gp procedure body-gp procedure call-gp parg list-gp parg-gpf-gpf list-gpf apply-gpf apply fun-gpf modifiers-gpf selectors-gpf adp-gpf each-gpf some-gpf all-gpf element type-gpf element list ('gpf element list,

t, t, t, c, e, t, t, t, t, t, n, t, s, t, t, t, t, x)

; *********************
;  The Meta Function P
; *********************

Definition: meta p (m, c, s, n, x) = let ptm be pt (m, 'statement),

ptx be pt (x, 'program description)

in if ptm = nil then marked ('statement syntax error, nil) elseif ptx = nil

then marked ('program description syntax error, nil)

else gp (ptm, c, s, n, ptx) endif endlet

Index

access, 81, 82, 84, 86, 167 actual cargs, 5, 6, 141, 189 actual dargs, 6, 7, 142 add to map, 20 all conditionsp, 19, 71, 83, 89 all determinate, 20, 37, 64 allocate, 64, 72, 86, 181, 182, 208,

230 allocate const, 64, 234–236 allocate const intro, 64 allocate intro, 64 apply var, 63, 75–78, 82, 84 arg check, 89 arg list, 187, 189 array get, 25 array put, 30 assert, 19, 20, 72, 73 assign dynamic name, 79

base type, 89, 162–164, 238, 239 bind local, 87, 88 boolean desc, 71, 146, 148, 157–160,

194, 195 boolean typep, 70, 71 bound id, 184, 214, 215, 217 bound values, 64 bounded typep, 66, 67

call state, 85 case label check, 89 case labels, 4, 5, 150, 151, 162, 164 cdr quantified exp, 184 character valuep, 202 component assign error, 33 component selectors, 2, 3 component td, 68, 69, 73, 74 cond+, 19–21, 87 cond arg check, 83 cond˜, 19, 20, 23–27, 29–64, 66, 69–

77, 80, 85–89, 160, 161, 171, 172, 175, 179 condition labels ok, 89, 160 condition non normal, 19, 153 condition normal, 19, 86, 160 conditionp, 19, 143, 173 const, 19–21 constant body, 5, 207 crd, 68

deallocate, 21 deallocate conds, 21, 65 deallocate consts, 21, 65 deallocate vars, 21, 65 default state, 18, 84 default value, 29, 33, 71 determinate, 19, 20, 23–27, 29–66,

69–74, 76, 77, 80, 84, 85, 88, 89

digit listp, 202 dparam name, 84, 86 dparam name list, 83

each clausep, 214–216 entry, 18 entry name, 202 entry not boolean error, 1, 71 entry valuep, 202 exit, 18 exit label error, 1, 71 exit labels, 7–9, 71 exit labels ok, 71 exit not boolean error, 2, 71 exit spec, 9, 10, 173 expression from spec, 157–160 extend name selectors, 3

farg check, 83 field names, 68 field td, 74 field tds, 68 fn call formp, 187, 189 forall, 22 formal cargs, 7, 83, 85–87, 179 formal dargs, 83, 85, 87, 206 formal type, 82, 84

gadjoin, 49, 75 gand, 20, 43, 72, 73 gappend, 52 gassign, 74 gassign0, 74–78, 86 gchar, 24 gcons, 52, 76 gdifference, 51 gdiv, 46 gequal, 22, 39, 79, 81 gf, 70–72 gfalse, 23 gge, 42 ggt, 42 giff, 44 gimp, 43 gin, 48 gintersect, 51 gizero, 18 gle, 41 glt, 40 gmap insert, 34, 75 gmapomit, 33, 77 gminus, 38 gmod, 46 gmove, 79, 80 gmove assign, 78, 80 gname, 5, 9, 142, 143, 180–182, 202,

208, 230 gne, 40 gnew, 76 gnew0, 75, 76, 78 gnot, 39 gomit, 50, 77 gor, 41 gp, 244, 254 gp assign, 75, 138 gp bind local, 88, 89 gp bind locals, 88, 89, 167 gp call state, 86, 178, 179 gp case body, 245 gp case label check, 89, 150, 152 gp cond, 244 gp deallocate locals, 65, 169–176, 178 gp local conds, 89, 167 gp locals, 245 gp map call effects, 87, 179 gp map call effects intro, 87 gp move, 80, 140 gp new, 77, 141 gp new namep, 87, 89, 233–235 gp parg, 247 gp parg list, 247 gp procedure body, 246 gp procedure call, 246 gp record assert, 73, 159, 160 gp remove, 78, 143 gp set entry, 71, 169–177 gp set exit, 72, 174 gp set keep, 72, 169–177 gp update assert, 73, 157 gp update keep, 72, 74, 76, 77, 80,

87 gpf, 248 gpf adp, 251 gpf all, 252 gpf apply, 249 gpf apply binary op, 53, 186 gpf apply fun, 249 gpf apply unary op, 39, 185, 199 gpf apply var, 63, 180–182, 202, 204 gpf array get, 26, 29, 32 gpf array put, 30, 32 gpf bound values, 64, 183–185, 214–

217 gpf bound values intro, 64 gpf each, 251 gpf element list, 253 gpf element type, 253 gpf false, 23, 204, 234 gpf gadjoin, 49, 54 gpf gand, 43, 53, 236 gpf gappend, 52, 54 gpf gchar, 25, 202 gpf gcons, 52, 54 gpf gdifference, 51, 54 gpf gdiv, 46, 54 gpf gequal, 40, 53 gpf gge, 43, 53 gpf ggt, 42, 53 gpf giff, 44, 53 gpf gimp, 44, 53 gpf gin, 48, 54, 162–164 gpf gintersect, 51, 54 gpf gle, 42, 53 gpf glt, 41, 53 gpf gmap insert, 34, 225 gpf gmapomit, 33, 228 gpf gminus, 38, 39 gpf gmod, 47, 54 gpf gne, 40, 53 gpf gnot, 39 gpf gomit, 50, 54 gpf gor, 41, 53, 235 gpf gplus, 47, 54 gpf gpower, 45, 53 gpf gquotient, 46, 54 gpf grange elements, 38, 242 gpf grcons, 53, 54 gpf gseq, 36, 38 gpf gseq insert before, 35, 221 gpf gseq insert behind, 36, 223 gpf gseqomit, 34, 226 gpf gset, 37, 38, 162–164 gpf gset or seq, 38, 201, 202 gpf gstring seq, 25, 203 gpf gsub, 50, 54 gpf gsubtract, 48, 54 gpf gtimes, 45, 54 gpf gunion, 49, 54 gpf list, 248 gpf mapping get, 26, 29, 33 gpf mapping put, 31, 33 gpf minteger, 24, 198, 202 gpf modifiers, 250 gpf put op, 32, 33, 219, 221, 223,

225, 226, 228 gpf record get, 27, 29, 32, 208 gpf record put, 31, 33 gpf retype result˜, 66, 207 gpf select op, 28, 29, 204, 206, 207,

209, 220, 222, 224, 226, 227 gpf selectors, 250 gpf sequence get, 27, 29, 33 gpf sequence put, 32, 33 gpf some, 252 gpf std domain, 55, 204 gpf std first, 55, 204 gpf std initial, 56, 204 gpf std last, 56, 204 gpf std lower, 57, 204 gpf std max, 57, 204 gpf std min, 58, 204 gpf std nonfirst, 58, 204 gpf std nonlast, 59, 205 gpf std null, 59, 205 gpf std ord, 60, 205 gpf std pred, 60, 205 gpf std range, 61, 205 gpf std scale, 61, 205 gpf std size, 62, 205 gpf std succ, 62, 205 gpf std upper, 63, 205 gpf subsequence get, 29, 30, 211 gpf true, 24, 204, 235 gpf type check, 70, 146–148, 158–160,

194, 195 gpf type name arg, 70, 204 gplus, 47 gpower, 44 gquotient, 45 grange elements, 37 grcons, 53, 76 gremove, 77 gremove0, 77, 80 gseq, 36 gseq insert before, 35, 76 gseq insert behind, 35, 76 gseqomit, 34, 77 gset, 37 gstring seq, 25 gsub, 50 gsubtract, 47 gtimes, 45 gtrue, 18, 24 gtruep, 22, 79, 81, 147, 158, 163,

195 gunion, 48, 49

handler, 10, 11, 160, 161 handler labels, 11, 160 harmful aliasp, 81 harmfully aliasedp, 81, 82

id list, 5–7, 11, 12, 167 identifierp, 4, 5, 9, 202 if else exp, 196 if statement else part, 13, 14, 147,

148 ileq, 66 implementation constrained, 22–27,

29–53, 55–64, 66, 69–74, 76, 77, 80, 88, 89

implementation constrained-nec

c, 23 implementation constrained-off, 22 implementation constrained-suf

f, 22 in map, 18, 19, 22, 87 in type, 65, 69, 74, 82, 88 indeterminate, 82, 86, 160, 169 integer desc, 29, 33, 68 integerp, 66 internal initial value exp, 12, 167

k, 22 keep, 19, 72 keep spec, 12, 13, 168–172, 174–177 keep˜, 19, 72 kind, 83, 85, 86, 178, 206

length, 83, 89, 206 local conds, 20, 65 local consts, 20, 65 local vars, 20, 65 locals, 19, 20 map, 18–23, 63, 70–72, 75–78, 80, 82, 84, 87, 179

map call effects, 86, 87

map cond effects, 86, 87, 179

map var effects, 86, 87

mapped value, 18, 19, 22, 23, 69 mapping descp, 77 mapping element lhsp, 74, 82 mapping get, 26 mapping put, 31 mapping selectionp, 73, 74 mark, 20–23, 65, 80, 179 mark state indeterminate, 20, 39, 54,

76, 78, 83, 86, 131, 143, 156, 160, 161, 164, 167, 168, 178–180, 183, 193, 203, 205– 207, 228, 231, 233–236, 240, 244

marked, 18, 20, 21, 23, 29, 33, 65, 70, 71, 74, 80, 84, 87, 88, 179, 208, 230, 254

max size, 68, 69 meta p, 254 minteger, 24 mk elif into if statement, 2, 14 mk empty, 2 mk entry name, 84 mk error, 1, 2 mk identifier, 2, 70 mk name expression, 3, 4, 180–182 mk opt condition handlers, 2 mk reserved word, 2 mk signal stmt, 2, 159 mk tree, 2–4 mk true expression, 13, 18 mk unary operator, 198 mode, 19, 29, 32, 68, 73 mutual-gp-gp cond-gp case bo

dy-gp locals-gp procedure bodygp procedure call-gp parg listg..., 130–167, 169–204, 206– 254

mutual-subtype-subtype fields, 68, 69 name exp, 65, 75–79, 180, 182 namep, 65, 74, 79, 81, 82, 84 ncopies, 89 ne name, 65, 74, 75, 77–79, 81, 82,

84 ne selectors, 65, 74, 75, 77–79, 81,

82, 84 new name arg, 14, 15, 140, 141 no harmful aliasing, 82, 83 non rational simple typep, 89 normal state, 19, 23–28, 30–32, 34–

53, 55–63, 66, 70–73, 75, 77, 78, 80, 83, 85, 86, 88, 89, 131, 146, 150, 158, 161, 162, 164, 178, 180, 181, 183, 184, 194, 207, 214–216, 228, 231, 233, 240

not selectable error, 29 note conds, 20, 85

object, 18, 65 object name, 188, 189 one parg check, 82, 83

p apply var, 63 p apply var intro, 63 p array get, 25, 26 p array get intro, 25 p array put, 30 p array put intro, 30 p assign, 74, 75 p assign intro, 74 p bind local, 88 p bind local intro, 88 p call state, 85, 86 p call state intro, 85 p case label check, 89 p case label check intro, 89 p gadjoin, 49 p gadjoin intro, 49 p gand, 43 p gand intro, 43 p gappend, 51, 52 p gappend intro, 51 p gchar, 24, 25 p gchar intro, 24 p gcons, 52 p gcons intro, 52 p gdifference, 51 p gdifference intro, 51 p gdiv, 46 p gdiv intro, 46 p gequal, 39, 40 p gequal intro, 39 p gfalse, 23 p gfalse intro, 23 p gge, 42, 43 p gge intro, 42 p ggt, 42 p ggt intro, 42 p giff, 44 p giff intro, 44 p gimp, 43, 44 p gimp intro, 43 p gin, 48 p gin intro, 48 p gintersect, 50, 51 p gintersect intro, 50 p gle, 41, 42 p gle intro, 41 p glt, 40, 41 p glt intro, 40 p gmap insert, 34, 35 p gmap insert intro, 34 p gmapomit, 33, 34 p gmapomit intro, 33 p gminus, 38 p gminus intro, 38 p gmod, 46, 47 p gmod intro, 46 p gne, 40 p gne intro, 40 p gnot, 39 p gnot intro, 39 p gomit, 49, 50 p gomit intro, 49 p gor, 41 p gor intro, 41 p gplus, 47 p gplus intro, 47 p gpower, 44, 45 p gpower intro, 44 p gquotient, 45, 46 p gquotient intro, 45 p grange elements, 37, 38 p grange elements intro, 37 p grcons, 53 p grcons intro, 53 p gseq, 36 p gseq insert before, 35 p gseq insert before intro, 35 p gseq insert behind, 35, 36 p gseq insert behind intro, 35 p gseq intro, 36 p gseqomit, 34 p gseqomit intro, 34 p gset, 36, 37 p gset intro, 36 p gstring seq, 25 p gstring seq intro, 25 p gsub, 50 p gsub intro, 50 p gsubtract, 47, 48 p gsubtract intro, 47 p gtimes, 45 p gtimes intro, 45 p gtrue, 24 p gtrue intro, 24 p gunion, 48, 49 p gunion intro, 48 p mapping get, 26 p mapping get intro, 26 p mapping put, 31 p mapping put intro, 31 p minteger, 24 p minteger intro, 24 p move, 80 p move intro, 80 p new, 76, 77 p new intro, 76 p record assert, 73 p record assert intro, 73 p record get, 26, 27 p record get intro, 26 p record put, 30, 31 p record put intro, 30 p remove, 77, 78 p remove intro, 77 p retype result˜, 66 p retype result˜ intro, 66 p sequence get, 27 p sequence get intro, 27 p sequence put, 31, 32 p sequence put intro, 31 p set entry, 71 p set entry intro, 71 p set exit, 71, 72 p set exit intro, 71 p std domain, 54, 55 p std domain intro, 54 p std first, 55 p std first intro, 55 p std initial, 55, 56 p std initial intro, 55 p std last, 56 p std last intro, 56 p std lower, 56, 57 p std lower intro, 56 p std max, 57 p std max intro, 57 p std min, 57, 58 p std min intro, 57 p std nonfirst, 58 p std nonfirst intro, 58 p std nonlast, 58, 59 p std nonlast intro, 58 p std null, 59 p std null intro, 59 p std ord, 59, 60 p std ord intro, 59 p std pred, 60 p std pred intro, 60 p std range, 60, 61 p std range intro, 60 p std scale, 61 p std scale intro, 61 p std size, 61, 62 p std size intro, 61 p std succ, 62 p std succ intro, 62 p std upper, 62, 63 p std upper intro, 62 p subsequence get, 29, 30 p subsequence get intro, 29 p type check, 69, 70 p type check intro, 69 p type name arg, 70 p type name arg intro, 70 p update assert, 72, 73 p update assert intro, 72 p update keep, 72 p update keep intro, 72 padd darg, 84 padd result, 84, 85 parg check, 83, 85 parg check2, 82, 83 pbind dargs, 84, 85 pformals ok, 81, 83 postc, 71 prec, 168, 170–177 procedure body, 17, 178 prodn, 3–17, 38, 39, 53, 54, 75, 76,

78, 79, 131–146, 149, 152, 154–157, 161, 162, 164, 165, 167, 168, 180, 181, 183–187, 189–194, 196–201, 207–213, 215, 216, 218, 219, 221, 223, 225, 226, 228–232, 236–243

pt, 254 put op, 74

range element state list, 37, 38 range element state list2, 37 rationalp, 66 rcar, 75–77, 84, 220, 222, 224, 226,

228, 235, 236 rcdr, 75–79, 84, 219–227, 235, 236 rcons, 4–7, 32, 232, 233, 243, 244 record assert, 73 record assertion, 20 record get, 26 record put, 31 ref, 178, 179, 206, 207 remove, 21 remove dynamic name, 79 remove exp arg, 15, 16, 139, 142 remove name arg, 16, 139, 143 reserved idp, 81, 87 reset leave to normal, 20, 153 result type, 85, 207 result˜, 19, 26, 27, 29–53, 65, 69, 75,

77, 78, 80, 88, 89, 147, 158– 160, 162–164, 184, 185, 195, 214, 216, 217, 238, 239

result˜ list, 19, 36, 37, 55–63, 86, 89, 179, 182

retype result˜, 65, 66

rleq, 66 root, 3, 19 rule, 3–17, 38, 39, 53, 54, 75, 76,

78, 79, 131–146, 149, 152, 154–157, 161, 162, 164, 165, 167, 168, 180, 181, 183–187, 189–194, 196–201, 207–213, 215, 216, 218, 219, 221, 223, 225, 226, 228–232, 236–243

same names, 79

same selectors, 78, 79

scomp equal, 22 selector td, 68 selectors aliasedp, 81 sequal, 22–27, 29–53, 55–64, 66, 69–

74, 76, 77, 80, 85, 87–89 sequence descp, 78 sequence get, 27 sequence put, 32 set condition, 20, 23, 63, 65, 69, 74,

78, 80, 82–86, 88, 89, 138, 143, 161, 177, 179, 190, 204, 205, 207, 234–236

set entry, 70, 71 set equal, 22, 68 set exit, 71 setp, 71, 89 sid, 68, 69 smap equal, 22 ssubmap, 22 state check, 23, 26–28, 30–53, 55–

63, 75, 77, 78, 80, 86, 88, 89

state component, 18, 19, 74, 86 state componentp, 18, 19, 63, 74,

204 std domain, 55 std first, 55 std initial, 56, 84, 87 std last, 56 std lower, 57 std max, 57 std min, 58 std nonfirst, 58 std nonlast, 59 std null, 59 std ord, 60 std pred, 60 std range, 61 std scale, 61 std size, 62 std succ, 62 std upper, 63 store cond, 20, 71, 89 store const, 20, 64, 84, 85, 88 store result˜, 20, 29, 32, 33, 37 store value, 20, 21, 23–27, 29–53,

55–65, 70–74 store var, 21, 84, 85, 88 stored value, 78, 80 string valuep, 203 subsequence get, 29 subtree, 2–17, 78, 79, 131–140, 142–

157, 159, 161, 163, 165–177, 180–185, 187–193, 196–202, 207–209, 211–233, 236–241, 243, 244

subtree i, 185, 186, 194, 195, 210,

238, 241, 242 subtype, 69, 82 subtype fields, 69 subtype irange, 66, 68 subtype rrange, 66, 68 subtype size, 67–69

tag, 3–17, 38, 39, 53, 54, 75, 76, 78, 79, 131–146, 149, 152, 154–157, 161, 162, 164–168, 180, 181, 183–187, 189–194, 196–201, 207–213, 215, 216, 218, 219, 221, 223, 225, 226, 228–232, 236–243

tid, 68, 69 tmax, 66 tmin, 66 tree equal, 22 type, 19, 22, 26, 27, 29, 32, 70, 71,

77, 78, 82, 89, 162–164, 238, 239

type check, 69

type desc, 70, 82, 84, 85, 167, 207 type descp, 68 type equal, 68 type name arg, 70 type name expp, 204 type of, 19, 74 type vequal, 68 typed, 65, 74, 84, 88

update assert, 72, 73 update keep, 72

value, 65, 74, 84, 88

values, 89 var, 19–21 variablep, 19, 74, 82 vsetp, 89