<mdl.comp>/build-dir.mud.4

   1 ;"Build GDM Schema Directory
   2
   3         Contains directory related parser action routines and
   4         the routines that create the schema directory.  Directory
   5         data structure definitions are contained in GDM-DIR.MUD
   6 "
   7
   8 <PACKAGE "BUILD-DIR">
   9
  10 <ENTRY
  11         DIR-AC
  12         DIR-ACCESS-ENT
  13         DIR-ACCESS-FCN
  14         DIR-ACCESS-PATH
  15         DIR-ACCESS-UNIQUE
  16         DIR-AP-OPTIONS
  17         DIR-AYREA
  18         DIR-BIT
  19         DIR-CHR-BITS
  20         DIR-CHR-REP
  21         DIR-CONTEXT
  22         DIR-CONTEXT-DBA
  23         DIR-COTYPE
  24         DIR-DATABASE-ID
  25         DIR-DB-DEF
  26         DIR-DB-MAPPING
  27         DIR-DBMS-DEF
  28         DIR-DBMS-OPTIONS
  29         DIR-DBMS-TABLE
  30         DIR-DELETE-DB
  31         DIR-DELETE-DBMS
  32         DIR-DELETE-DIR
  33         DIR-DEMO-CMD
  34         DIR-DEMO-OFF
  35         DIR-DEMO-ON
  36         DIR-DIR-CMD
  37         DIR-ENTITY-EXTENT
  38         DIR-ENTITY-FUNC-EXTENT
  39         DIR-ENTITY-PRED-OPTN
  40         DIR-ENTITY-TYPE
  41         DIR-ENTITY-TYPE-EMPTY
  42         DIR-FCN-DEF
  43         DIR-FLUSH-DIR
  44         DIR-FOP-CALC
  45         DIR-FOP-CUR
  46         DIR-FOP-KEY
  47         DIR-FOP-OWN
  48         DIR-FOP-POS
  49         DIR-FOP-USE-CUR
  50         DIR-FOP-USE-NCUR
  51         DIR-FUNC-AOPS
  52         DIR-FUNC-EXTENT
  53         DIR-FUNC-ROPS
  54         DIR-INT-BITS
  55         DIR-INT-REP
  56         DIR-INT-STR
  57         DIR-KEY
  58         DIR-LOCAL-LDI
  59         DIR-MAX-ONLY
  60         DIR-MAX-PRED
  61         DIR-MAX-QPRED
  62         DIR-MAX-QREL
  63         DIR-MIN-MAX
  64         DIR-NO-AOPS
  65         DIR-NO-QUANT
  66         DIR-NO-ROPS
  67         DIR-OPTIONAL
  68         DIR-OWNER
  69         DIR-PRED-ITER
  70         DIR-PRED-OPTN
  71         DIR-PRED-QUANT
  72         DIR-PRINT-CH
  73         DIR-PRINT-DB
  74         DIR-PRINT-DBMS
  75         DIR-PRINT-DIR
  76         DIR-PRINT-ET
  77         DIR-QPRED-OPTN
  78         DIR-RANGE-ENTITY
  79         DIR-RANGE-INTEGER
  80         DIR-RANGE-STR
  81         DIR-READ-DIR
  82         DIR-READ-DIR-FILE
  83         DIR-REMOTE-LDI
  84         DIR-REPEAT-GRP
  85         DIR-SET
  86         DIR-SET-OF
  87         DIR-SPELLED
  88         DIR-SPELLED-2
  89         DIR-SUPERTYPE
  90         DIR-SUPPORTED-AOPS
  91         DIR-SUPPORTED-COPS
  92         DIR-SUPPORTED-DOPS
  93         DIR-SUPPORTED-EOPS
  94         DIR-SUPPORTED-FOPS
  95         DIR-SUPPORTED-GOPS
  96         DIR-SUPPORTED-LOPS
  97         DIR-SUPPORTED-QOPS
  98         DIR-SUPPORTED-QNTS
  99         DIR-SUPPORTED-ROPS
 100         DIR-SYS-EP
 101         DIR-SYS-EP-ACCESS
 102         DIR-SYS-EP-KEYS
 103         DIR-SYS-EP-OPTN
 104         DIR-SYS-EP-SET
 105         DIR-VIEW-DEF
 106         DIR-VISIBLE
 107         DIR-VISIBLE-CONSTRAINTS
 108         DIR-WRITE-DIR
 109         DIR-WRITE-DIR-FILE
 110         PP-DIR
 111
 112 ;"The following atoms are tokens that are referenced in here.  They
 113   must be included here so ==? comparisons will work. They were moved from gdm-parser"
 114         AC
 115 ;"      ACCESS"
 116         ALL
 117 ;"      ASCII"
 118         BCD
 119         BIT
 120         CHR-BIT
 121         CHR-REP
 122         CONSTANT
 123         CREATE
 124         DEMO-OFF
 125         DEMO-ON
 126         EQUALITY
 127         EXPRESSION
 128         FIELD
 129         FOUND
 130         INEQUALITY
 131         INT-BIT
 132         INT-REP
 133         INT-STR
 134         MULTIPLE
 135         NESTED
 136         NON_QUANTIFIED
 137         ONES
 138         OWNED
 139         PARALLEL
 140         PRINTING
 141         PROPAGATE
 142         QUANTIFIED
 143         RANGE
 144         REFERENCE
 145         REPEATING
 146         RESTRICTED
 147 ;"      SET"
 148         SPELLED
 149         STRICT
 150         SYS-EP
 151         TWOS
 152         UNIQUE
 153 >
 154
 155 <USE "GDM-DIR" "GDM-UTIL" "PARSE-DEFINITIONS"  "DEMO">
 156 <USE "EM" "BUILD-VIEW" "BUILD-CONSTRAINTS">
 157
 158
 159 ;"\f"
 160 ;"CREATE-DB performs context analysis of a data base schema definition
 161   command.  If no errors are detected, the new entity types defined
 162   in the schema are added to the ENTITY-TYPE-TABLE."
 163
 164 <DEFINE CREATE-DB (DB "AUX" (VID <+ 1 <LENGTH ,VIEW-TAB>>)
 165                             (EV <IVECTOR <LENGTH <3 .DB>><>>)
 166                             (EID-BASE <LENGTH ,ET-TABLE>)
 167                             I
 168                             DBMS-ID
 169                             FV
 170                       "ACT" ACT)
 171         #DECL ((DB EV FV) VECTOR
 172                 (I VID EID-BASE DBMS-ID) FIX)
 173
 174 ;"Check that database name matches name on END statement"
 175
 176         <COND (<2 .DB>
 177                 <COND (<NOT <==? <1 .DB> <2 .DB>>>
 178                         <ERR "Name on END statement does not match database name">
 179                         <RETURN <> .ACT>)>)>
 180
 181 ;"Check that database name is unique"
 182
 183         <MAPF   <>
 184                 <FUNCTION (V)
 185                         #DECL ((V) VIEW)
 186                         <COND (<==? <1 .DB> <V-NAME .V>>
 187                                 <ERR <STRING "Database name "
 188                                              <SPNAME <1 .DB>>
 189                                              " is already defined.">>
 190                                 <RETURN <> .ACT>)>>
 191                 ,VIEW-TAB>
 192
 193 ;"Check that database name matches an existing DBMS name and save its
 194   DBMS id."
 195
 196         <SET I 0>
 197         <COND (<NOT <MAPF <>
 198                           <FUNCTION (D)
 199                                 #DECL ((D) DBMS)
 200                                 <SET I <+ .I 1>>
 201                                 <COND (<==? <DB-SCHEMA-NAME .D> <1 .DB>>
 202                                         <SET DBMS-ID .I>
 203                                         <MAPLEAVE>)>>
 204                           ,DBMS-TAB>>
 205                 <ERR <STRING "No local DBMS defined for "
 206                              <SPNAME <1 .DB>> ".">>
 207                 <RETURN <> .ACT>)>
 208
 209 ;"Build entity type table for database"
 210
 211         <SET I 0>
 212         <MAPF   <>
 213                 <FUNCTION (E)
 214                         #DECL ((E) LIST)
 215                         <COND (<FIND-ETID .EV <1 .E>>
 216                                 <ERR <STRING "Entity type "
 217                                              <SPNAME <1 .E>>
 218                                              " is defined more than once.">>
 219                                 <RETURN <> .ACT>)>
 220                         <SET I <+ .I 1>>
 221                         <PUT .EV .I <CHTYPE [<1 .E>
 222                                         <+ .I .EID-BASE>
 223                                         .VID
 224                                         <CHTYPE () ETID-LIST>
 225                                         <CHTYPE () ETID-LIST>
 226                                         <CHTYPE () ETID-LIST>
 227                                         <CREATE-FUNCTIONS <1 .E>
 228                                                           <2 .E> .DBMS-ID .ACT>
 229                                         <CREATE-DEFAULT-EREP .DBMS-ID>
 230                                         ET-LOCAL-SCHEMA] ENTITY-TYPE>>>
 231                 <3 .DB>>
 232
 233 ;"Make a pass through all functions of type F-ENTITY and replace
 234   entity type name with ETID.  Also set '# chars to print' default
 235   for all functions of type F-STRING."
 236
 237         <MAPF   <>
 238                 <FUNCTION (E "AUX" (FL <ET-FUNCTIONS .E>))
 239                   #DECL ((E) ENTITY-TYPE (FL) VECTOR)
 240                   <PUT <ET-MAP-INFO .E> ,E-SPELLING <SPNAME <ET-NAME .E>>>
 241                   <MAPF <>
 242                         <FUNCTION (F "AUX" X)
 243                           #DECL ((F) ENTITY-FUNC (X) <OR FIX FALSE>)
 244                           <PUT <F-MAP-INFO .F> ,F-SPELLING <SPNAME <F-NAME .F>>>
 245                           <COND (<==? <F-TYPE .F> F-ENTITY>
 246                                  <SET X <FIND-ETID .EV <F-ETID .F>>>
 247                                  <COND (.X
 248                                         <PUT .F ,F-ETID .X>)
 249                                        (ELSE
 250                                         <ERR <STRING "Entity type "
 251                                                      <SPNAME <F-ETID .F>>
 252                                                      " is undefined.">>)>)>
 253                           <COND (<==? <F-TYPE .F> F-STRING>
 254                                  <PUT <F-MAP-INFO .F> ,F-MIN-CHR <F-MIN .F>>
 255                                  <PUT <F-MAP-INFO .F> ,F-MAX-CHR <F-MAX .F>>
 256                                  <PUT <F-MAP-INFO .F> ,F-CONV-CHARS <F-MAX .F>>)>>
 257                         .FL>>
 258                 .EV>
 259
 260 ;"Process mapping information"
 261
 262         <MAPF <>
 263               <FUNCTION (E "AUX" ETID EMAP)
 264                 #DECL ((E) LIST (ETID) <OR FIX FALSE> (EMAP) E-PHY-REP)
 265                 <COND (<NOT <SET ETID <FIND-ETID .EV <1 .E>>>>
 266                         <ERR <STRING "Entity name " <SPNAME <1 .E>>
 267                                      " is undefined.">>
 268                         <RETURN <> .ACT>)>
 269                 <SET ETID <- .ETID .EID-BASE>> ;"Setup index into EV"
 270                 <SET EMAP <ET-MAP-INFO <.ETID .EV>>>
 271                 <SET FV <ET-FUNCTIONS <.ETID .EV>>>
 272                 <COND ( <NOT <FIND KEY <2 .E> 1>>
 273                         <ERR "Entity " <SPNAME <ET-NAME <.ETID .EV>>> " does not have any keys.">
 274                         <RETURN <> .ACT>)>
 275                 <MAPF <>
 276                       <FUNCTION (M)
 277                         #DECL ((M) LIST)
 278                         <COND (<==? <1 .M> FOUND>
 279                                 <PUT .EMAP ,E-CONTEXT <2 .M>>)>
 280                         <COND (<==? <1 .M> SYS-EP>
 281                                 <MAPF <>
 282                                       <FUNCTION (OPTN)
 283                                         #DECL ((OPTN) LIST)
 284                                         <COND ( <==? <1 .OPTN> SETNAME>
 285                                                 <PUT .EMAP ,E-SYS-SET <2 .OPTN>>)
 286                                               ( <==? <1 .OPTN> ACCESS>
 287                                                 <PUT .EMAP ,E-SYS-EP-AP-ONLY T>)
 288                                               ( <==? <1 .OPTN> KEYS>
 289                                                 <PUT .EMAP ,E-SYS-EP-KEYS <2 .OPTN>>)>
 290                                         >
 291                                         <2 .M>
 292                                 >
 293                                 <PUT .EMAP ,E-SYS-EP T>)>
 294                         <COND (<==? <1 .M> SPELLED>
 295                                 <PUT .EMAP ,E-SPELLING <2 .M>>)>
 296                         <COND (<==? <1 .M> AREA>
 297                                 <PUT .EMAP ,E-AREAS <2 .M>>)>
 298                         <COND (<==? <1 .M> OWNED>
 299                                 <MAPF <>
 300                                       <FUNCTION (OWNER "AUX" X)
 301                                         #DECL ((OWNER) IDENTIFIER (X) <OR FALSE FIX>)
 302                                         <COND (<SET X <FIND-ETID .EV <ID-NAME .OWNER>>>
 303                                                 <PUT .EMAP ,E-OWNERS <CHTYPE (.X !<E-OWNERS .EMAP>) ETID-LIST>>)
 304                                               (ELSE
 305                                                 <ERR <STRING "Entity type "
 306                                                         <SPNAME <ID-NAME .OWNER>>
 307                                                         " is undefined.">>
 308                                                 <RETURN <> .ACT>)>>
 309                               <2 .M>>)>
 310                         <COND (<==? <1 .M> PRED-OPTN>
 311                                 <MAPF <>
 312                                       <FUNCTION (M)
 313                                         #DECL ((M) LIST)
 314                                         <COND (<==? <1 .M> ITER-DOMAIN>
 315                                                 <PUT .EMAP ,E-ITER-PRED <2 .M>>)>
 316                                         <COND (<==? <1 .M> QUANT-DOMAIN>
 317                                                 <PUT .EMAP ,E-QUANT-PRED <2 .M>>)>
 318                                         <COND (<==? <1 .M> NO-QUANT>
 319                                                 <PUT .EMAP ,E-NO-QUANT T>)>
 320                                       >
 321                                       <2 .M>>)>
 322                         <COND ( <==? <1 .M> KEY>
 323                                 <MAPR <>
 324                                       <FUNCTION (ID "AUX" X)
 325                                         #DECL((ID) LIST (X) <OR FIX FALSE>)
 326                                         <COND (<SET X <FIND-FID .FV <ID-NAME <1 .ID>>>>
 327                                                 <PUT .ID 1 .X>)
 328                                               (ELSE
 329                                                 <ERR "Function "
 330                                                      <SPNAME <ID-NAME <1 .ID>>>
 331                                                      " is not defined in entity type "
 332                                                      <SPNAME <ET-NAME <.ETID .EV>>>>
 333                                                 <RETURN <> .ACT>)>>
 334                                       <2 .M>>
 335                                 <PUT .EMAP ,E-KEY <CHTYPE <2 .M> FCNID-LIST>>)>
 336                      >
 337                      <2 .E>>
 338                 <MAPF <>
 339                       <FUNCTION (F "AUX" FID FMAP)
 340                         #DECL ((F) LIST (FID) <OR FIX FALSE> (FMAP) F-PHY-REP)
 341                         <COND (<NOT <SET FID <FIND-FID .FV <1 .F>>>>
 342                                 <ERR <STRING "Function " <SPNAME <1 .F>>
 343                                              " is not defined in entity type "
 344                                              <SPNAME <ET-NAME <.ETID .EV>>>>>
 345                                 <RETURN <> .ACT>)>
 346                         <SET FMAP <F-MAP-INFO <.FID .FV>>>
 347
 348 ;"If this is really an integer string then setup correct defaults."
 349
 350                         <MAPF <>
 351                               <FUNCTION (FM)
 352                                 #DECL ((FM) LIST)
 353                                 <COND (<==? <1 .FM> INT-STR>
 354                                         <PUT .FMAP ,F-REP
 355                                              <DB-DEF-STR-REP <DB-OPTIONS <.DBMS-ID ,DBMS-TAB>>>>
 356                                         <PUT .FMAP ,F-BITS
 357                                              <DB-DEF-STR-BITS <DB-OPTIONS <.DBMS-ID ,DBMS-TAB>>>>
 358                                         <PUT .FMAP ,F-CONV-CHARS
 359                                              <3 .FM>>)>>
 360                               <2 .F>>
 361
 362                         <MAPF <>
 363                               <FUNCTION (FM)
 364                                 #DECL ((FM) LIST)
 365                                 <COND (<==? <1 .FM> ACCESS>
 366                                         <PUT .FMAP ,F-AP-SPELLING <F-SPELLING .FMAP>>
 367                                         <MAPF <>
 368                                               <FUNCTION (OPTN "AUX" X)
 369                                                 #DECL ((OPTN) LIST (X) <OR FIX FALSE>)
 370                                                 <COND (<==? <1 .OPTN> UNIQUE>
 371                                                         <PUT .FMAP ,F-AP-UNIQUE T>)
 372                                                       (<==? <1 .OPTN> SPELLED>
 373                                                         <PUT .FMAP ,F-AP-SPELLING <2 .OPTN>>)
 374                                                       (<==? <1 .OPTN> SELECTS>
 375                                                         <COND (<SET X <FIND-ETID .EV <ID-NAME <2 .OPTN>>>>
 376                                                                 <PUT .FMAP ,F-AP-SELECTS .X>)
 377                                                               (ELSE
 378                                                                 <ERR "Entity type "
 379                                                                      <SPNAME <ID-NAME <2 .OPTN>>>
 380                                                                      " is undefined.">
 381                                                                 <RETURN <> .ACT>)>)
 382                                                       (<==? <1 .OPTN> WITH>
 383                                                         <MAPR <>
 384                                                               <FUNCTION (ID "AUX" X)
 385                                                                 #DECL((ID) LIST (X) <OR FIX FALSE>)
 386                                                                 <COND (<SET X <FIND-FID .FV <ID-NAME <1 .ID>>>>
 387                                                                         <PUT .ID 1 .X>)
 388                                                                       (ELSE
 389                                                                         <ERR "Function "
 390                                                                              <SPNAME <ID-NAME <1 .ID>>>
 391                                                                              " is not defined in entity type "
 392                                                                              <SPNAME <ET-NAME <.ETID .EV>>>>
 393                                                                         <RETURN <> .ACT>)>>
 394                                                               <2 .OPTN>>
 395                                                         <PUT .FMAP ,F-AP-CO-FCNS <CHTYPE <2 .OPTN> FCNID-LIST>>)>
 396                                               >
 397                                               <3 .FM>>
 398                                         <COND (<==? <2 .FM> EQUALITY>
 399                                                 <PUT .EMAP ,E-AP-EQ-COUNT
 400                                                   <+ <E-AP-EQ-COUNT .EMAP> 1>>
 401                                                 <PUT .FMAP ,F-AP-EQ T>)>
 402                                         <COND (<==? <2 .FM> INEQUALITY>
 403                                                 <PUT .FMAP ,F-AP-NQ T>)>
 404                                         <COND (<==? <2 .FM> RANGE>
 405                                                 <PUT .FMAP ,F-AP-RANGE T>)>)>
 406                                 <COND (<==? <1 .FM> SPELLED>
 407                                         <PUT .FMAP ,F-SPELLING <2 .FM>>)>
 408                                 <COND (<==? <1 .FM> SET>
 409                                         <PUT .FMAP ,F-SET T>)>
 410                                 <COND (<==? <1 .FM> REPEAT>
 411                                         <PUT .FMAP ,F-REPEAT-GRP T>)>
 412                                 <COND (<==? <1 .FM> INT-STR>
 413                                         <PUT .FMAP ,F-INT-STR T>
 414                                         <PUT .FMAP ,F-MIN-CHR <2 .FM>>
 415                                         <PUT .FMAP ,F-MAX-CHR <3 .FM>>)>
 416                                 <COND (<==? <1 .FM> PRINTING>
 417                                         <PUT .FMAP ,F-CONV-CHARS <2 .FM>>)>
 418                                 <COND (<==? <1 .FM> BIT>
 419                                         <PUT .FMAP ,F-BITS <2 .FM>>
 420                                         <COND (<==? <3 .FM> ASCII>
 421                                                 <PUT .FMAP ,F-REP DB-ASCII>)>
 422                                         <COND (<==? <3 .FM> BCD>
 423                                                 <PUT .FMAP ,F-REP DB-BCD>)>
 424                                         <COND (<==? <3 .FM> ONES>
 425                                                 <PUT .FMAP ,F-REP DB-ONES-COMP>)>
 426                                         <COND (<==? <3 .FM> TWOS>
 427                                                 <PUT .FMAP ,F-REP DB-TWOS-COMP>)>)>
 428                                 <COND (<==? <1 .FM> AOPS>
 429                                         <PUT .FMAP ,F-ARITH-OPS <2 .FM>>)>
 430                                 <COND (<==? <1 .FM> ROPS>
 431                                         <PUT .FMAP ,F-REL-OPS <2 .FM>>)>
 432                               >
 433                               <2 .F>>>
 434                 <3 .E>>>
 435               <4 .DB>>
 436
 437 ;"Add entity type constraints"
 438
 439         <COND ( <NOT <BUILD-CONSTRAINTS .EV <5 .DB>>>
 440                 <RETURN <> .ACT>)>
 441
 442 ;"Now add structures to schema directory"
 443
 444         <PUT ,SCHEMA-DIR ,VIEW-TABLE
 445                 [!<VIEW-TABLE ,SCHEMA-DIR> <CHTYPE [<1 .DB>] VIEW>]>
 446         <SETG VIEW-TAB <VIEW-TABLE ,SCHEMA-DIR>>
 447         <PUT ,SCHEMA-DIR ,ENTITY-TYPE-TABLE
 448                 [!<ENTITY-TYPE-TABLE ,SCHEMA-DIR> !.EV]>
 449         <SETG ET-TABLE <ENTITY-TYPE-TABLE ,SCHEMA-DIR>>
 450         <SETG LEN-ET-TABLE <LENGTH ,ET-TABLE>>
 451         <MSG <STRING "Database " <SPNAME <1 .DB>> " added to global schema.">>
 452
 453 > ;"CREATE-DB"
 454 "\f"
 455 ;"CREATE-DBMS performs context analysis of the local DBMS specification
 456   command.  If no errors are found a new entry will be created in the
 457   DBMS-TABLE."
 458
 459 <DEFINE CREATE-DBMS (DBMS-ENTRY)
 460         #DECL ((DBMS-ENTRY) DBMS)
 461         <COND (<NOT <MAPF <>    ;"Make one pass to insure unique DBMS name"
 462                           <FUNCTION (E)
 463                             <COND (.E
 464                                     <COND (<==? <DB-SCHEMA-NAME .DBMS-ENTRY>
 465                                             <DB-SCHEMA-NAME .E>>
 466                                         <ERR <STRING "Local DBMS " <SPNAME <DB-SCHEMA-NAME .E>> " is already defined.">>
 467                                         <MAPLEAVE>)>)>>
 468                           <DBMS-TABLE ,SCHEMA-DIR>>>
 469                 <PUT ,SCHEMA-DIR ,DBMS-TABLE [!<DBMS-TABLE ,SCHEMA-DIR>
 470                                                         .DBMS-ENTRY]>
 471                 <SETG DBMS-TAB <DBMS-TABLE ,SCHEMA-DIR>>
 472                 <MSG <STRING "DBMS " <SPNAME <DB-SCHEMA-NAME .DBMS-ENTRY>>
 473                                 " added to global schema.">>)>>
 474 ;"\f"
 475 ;"CREATE-DEFAULT-EREP creates a default physical entity type
 476   representation.  DBMS-ID is the index into the DBMS-TABLE."
 477
 478 <DEFINE CREATE-DEFAULT-EREP (DBMS-ID)
 479         #DECL ((DBMS-ID) FIX)
 480         <CHTYPE [.DBMS-ID <> <> <CHTYPE () ETID-LIST> <> 0 <> <>
 481                  <> <> <> <> <> <> <>] E-PHY-REP>>
 482
 483
 484
 485
 486
 487 ;"CREATE-DEFAULT-FREP creates a default physical function
 488   representation.  FUNC-TYPE is the function type (string, integer...)
 489   and DBMS-ID is the index into the DBMS-TABLE"
 490
 491 <DEFINE CREATE-DEFAULT-FREP (FUNC-TYPE DBMS-ID
 492                                 "AUX" (O <DB-OPTIONS <.DBMS-ID ,DBMS-TAB>>))
 493         #DECL ((FUNC-TYPE) ATOM (DBMS-ID) FIX (O) DBMS-OPTIONS)
 494         <COND (<==? .FUNC-TYPE F-STRING>
 495                 <CHTYPE [<> <> <> <DB-DEF-STR-BITS .O>
 496                                   <DB-DEF-STR-REP .O>
 497                                   <> <> <>
 498                                   ,SYS-DEF-INT-BITS
 499                                   0 0 0 <> <> <> <> <>
 500                                   <DB-REL-OPS .O>
 501                                   <DB-ARITH-OPS .O>] F-PHY-REP>)
 502               (ELSE
 503                 <CHTYPE [<> <> <> <DB-DEF-INT-BITS .O>
 504                                   <DB-DEF-INT-REP .O>
 505                                   <> <> <>
 506                                   ,SYS-DEF-INT-BITS
 507                                   ,SYS-DEF-PRINT-INT
 508                                   0 0 <> <> <> <> <>
 509                                   <DB-REL-OPS .O>
 510                                   <DB-ARITH-OPS .O>] F-PHY-REP>)>>
 511 ;"\f"
 512 ;"CREATE-FUNCTIONS creates a vector of entity function specifications."
 513
 514 <DEFINE CREATE-FUNCTIONS (ENAME FL DBMS-ID ERROR-EXIT "AUX" (V []))
 515         #DECL ((FL) LIST (DBMS-ID) FIX (V) VECTOR
 516                 (ENAME) ATOM
 517                 (ERROR-EXIT) ACTIVATION)
 518         <MAPF <>
 519               <FUNCTION (F)
 520                 #DECL ((F) ENTITY-FUNC)
 521                 <MAPF <>
 522                       <FUNCTION (VF)
 523                         #DECL ((VF) ENTITY-FUNC)
 524                         <COND (<==? <F-NAME .VF> <F-NAME .F>>
 525                                 <ERR <STRING "Function name "
 526                                              <SPNAME <F-NAME .F>>
 527                                              " in entity type "
 528                                              <SPNAME .ENAME>
 529                                              " defined more than once.">>
 530                                 <RETURN <> .ERROR-EXIT>)>>
 531                       .V>
 532                 <PUT .F ,F-MAP-TYPE F-LOCAL-SCHEMA>
 533                 <PUT .F ,F-MAP-INFO <CREATE-DEFAULT-FREP <F-TYPE .F> .DBMS-ID>>
 534                 <SET V [!.V .F]>>
 535                 .FL>>
 536 ;"\f"
 537
 538 ;"DEMO-COMMAND processes various demo commands."
 539
 540 <DEFINE DEMO-COMMAND (CMD)
 541         #DECL ((CMD) ATOM)
 542         <COND (<==? .CMD DEMO-ON>
 543                 <SETG DEMO T>
 544                 <DEMO-INIT >
 545                 <CALL-ALL-LDIS-SIMPLE "DEMO-CMD" ON>)
 546               (<==? .CMD DEMO-OFF>
 547                 <SETG DEMO <>>
 548                 <CALL-ALL-LDIS-SIMPLE "DEMO-CMD" <>>)
 549               (ELSE
 550                 <ERR "Unknown demo command.">)>
 551         <RESERVE-SPACE> ;"tries to make sure there is enough garbage collection room"
 552         <>>
 553 ;"\f"
 554 ;"All routines beginning with DIR- are DBA command action routines."
 555
 556 ;"DIR-AC returns the keyword AC
 557   Production: ALPHA_COLLATING  "
 558
 559 <DEFINE DIR-AC (X)
 560         AC>
 561
 562
 563 ;"DIR-ACCESS-ENT returns a list which indicates the entity
 564   selected by an access path.
 565   Production: SELECTS entity-name ; "
 566
 567 <DEFINE DIR-ACCESS-ENT (X ENTITY Y)
 568         #DECL ( (ENTITY) IDENTIFIER)
 569         (SELECTS .ENTITY)>
 570
 571
 572
 573 ;"DIR-ACCESS-FCN returns a list which indicates other functions
 574   which must be present to make a complete access path.
 575   Production: WITH functin_list ; "
 576
 577 <DEFINE DIR-ACCESS-FCN (X FCN-LIST Y)
 578         #DECL ( (FCN-LIST) LIST)
 579         (WITH .FCN-LIST)>
 580
 581
 582
 583 ;"DIR-ACCESS-PATH returns a list containing the keyword ACCESS and
 584   the type of comparison that can be done.
 585   Production: ACCESS PATH VIA compare_type ;  "
 586
 587 <DEFINE DIR-ACCESS-PATH (W X Y CTYPE Z)
 588         #DECL ((CTYPE) ATOM)
 589         (ACCESS .CTYPE ())>
 590
 591
 592
 593
 594 ;"DIR-ACCESS-UNIQUE returns a list indicating that the access path is unique.
 595   Production: UNIQUE ;  "
 596
 597 <DEFINE DIR-ACCESS-UNIQUE (X Y)
 598         (UNIQUE)>
 599
 600
 601 ;"DIR-AP-OPTIONS returns a list containing the keyword ACCESS and the
 602   list of options specified for the access path.
 603   Production: ACCESS PATH VIA compare_type access_paht_list   "
 604
 605 <DEFINE DIR-AP-OPTIONS (V W X CTYPE OPTN)
 606         #DECL ((CTYPE) ATOM (OPTN) LIST)
 607         (ACCESS .CTYPE .OPTN)>
 608
 609
 610
 611
 612 ;"DIR-AYREA creates a list containing the keyword AREA and a list
 613   area names.
 614   Production: AREAS area_list  "
 615
 616 <DEFINE DIR-AYREA (X AREA-LIST Y)
 617         #DECL ((AREA-LIST) LIST)
 618         (AREA <CHTYPE .AREA-LIST AREAS>)>
 619 ;"\f"
 620 ;"DIR-BIT returns a list containing the keyword BIT and the bit size
 621   of the function value and its representation.
 622   Production: number BIT representation  "
 623
 624 <DEFINE DIR-BIT (NUM X VREP)
 625         #DECL ((NUM) FIX (VREP) ATOM)
 626         (BIT .NUM .VREP)>
 627
 628
 629
 630
 631
 632 ;"DIR-CHR-BITS returns a list containing the keyword CHR-BIT and
 633   the character size in bits.
 634   Production: DEFAULT CHAR BIT SIZE IS number  "
 635
 636 <DEFINE DIR-CHR-BITS (V W X Y Z BIT-SIZE)
 637         #DECL ((BIT-SIZE) FIX)
 638         (CHR-BIT .BIT-SIZE)>
 639
 640
 641
 642
 643 ;"DIR-CHR-REP returns a list containing the keyword CHR-REP and
 644   the character representation.
 645   Production: DEFAULT CHAR REP IS representation  "
 646
 647 <DEFINE DIR-CHR-REP (W X Y Z VREP)
 648         #DECL ((VREP) ATOM)
 649         (CHR-REP .VREP)>
 650
 651
 652
 653
 654 ;"\f"
 655 ;"DIR-CONTEXT returns a list containing the keyword FOUND and a string
 656   representing the context in which the entity type is found.
 657   Production: FOUND UNDER character_string ;  "
 658
 659 <DEFINE DIR-CONTEXT (X Y CONTEXT Z)
 660         #DECL ((CONTEXT) STRING)
 661         (FOUND .CONTEXT)>
 662
 663
 664
 665
 666
 667 ;"DIR-CONTEXT-DBA is the main entry point for context analysis.  Determines
 668   the DBA command type and invokes the appropriate routine."
 669
 670 <DEFINE DIR-CONTEXT-DBA (COMMAND "ACT" ACT)
 671         #DECL ((COMMAND) <OR DBMS-DEF DB-DEF VIEW-DEF DIR-CMD DEMO-CMD>
 672                 (ACT) ACTIVATION)
 673         <COND (<TYPE? .COMMAND DBMS-DEF>
 674                 <CREATE-DBMS <1 .COMMAND>>)
 675               (<TYPE? .COMMAND DIR-CMD>
 676                 <RETURN <> .ACT>)
 677               (<TYPE? .COMMAND DB-DEF>
 678                 <CREATE-DB <1 .COMMAND>>)
 679               (<TYPE? .COMMAND VIEW-DEF>
 680                 <CREATE-VIEW  .COMMAND>)
 681               (<TYPE? .COMMAND DEMO-CMD>
 682                 <DEMO-COMMAND <1 .COMMAND>>)>>
 683 ;"\f"
 684
 685   ;"Production: SHARE entity_name WITH entity_list ; "
 686
 687 <DEFINE DIR-COTYPE (X ID Y EL Z)
 688         #DECL ((EL) LIST (ID) IDENTIFIER)
 689         <ERR "Share statement not implemented">
 690         <CHTYPE [.ID .EL] SHARE>
 691 >
 692
 693
 694
 695
 696
 697 ;"DIR-DATABASE-ID is called when a database definition containing a
 698   database name on its END statement is recognized.  The name is saved
 699   and later checked against the database name for consistency.
 700   Production: basic_database database_name ;  "
 701
 702 <DEFINE DIR-DATABASE-ID (BASIC-DB DB-NAME X)
 703         #DECL ((BASIC-DB) VECTOR (DB-NAME) IDENTIFIER)
 704         <PUT .BASIC-DB 2 <ID-NAME .DB-NAME>>>
 705
 706
 707
 708
 709
 710 ;"DIR-DB-DEF changes the structure built while parsing a data base
 711   definition command to be a vector of type DB-DEF.
 712   Production: database_definition  "
 713
 714 <DEFINE DIR-DB-DEF (STRUCT)
 715         #DECL ((STRUCT) VECTOR)
 716         <CHTYPE [.STRUCT] DB-DEF>>
 717
 718
 719
 720
 721
 722 ;"DIR-DB-MAPPING inserts the list containing entity mapping information
 723   into the vector describing the database.
 724   Production: DATABASE db_visible_part db_map_part END "
 725
 726 <DEFINE DIR-DB-MAPPING (X VP MP Y)
 727         #DECL ((VP) VECTOR (MP) LIST)
 728         <PUT .VP 4 .MP>>
 729
 730
 731
 732
 733
 734 ;"DIR-DBMS-DEF changes the structure built while parsing a local
 735   DBMS specification command to be a vector of type DBMS-DEF.
 736   Production: dbms_definition  "
 737
 738 <DEFINE DIR-DBMS-DEF (STRUCT)
 739         #DECL ((STRUCT) DBMS)
 740         <CHTYPE [.STRUCT] DBMS-DEF>>
 741 ;"\f"
 742 ;"DIR-DBMS-OPTIONS builds a complete DBMS-TABLE entry by formating
 743   a DBMS options list and adding it to the fixed portion of a
 744   DBMS-TABLE entry.  The DBMS options list contains information
 745   describing which operations are supported on a local DBMS.
 746   Production: basic_dbms_definition dbms_option_list ;  "
 747
 748 <DEFINE DIR-DBMS-OPTIONS (DBMS-ENTRY OPTION-LIST X
 749         "AUX"   (OPT <CHTYPE <VECTOR    ,SYS-DEF-INT-BITS
 750                                         ,SYS-DEF-INT-REP
 751                                         ,SYS-DEF-STR-BITS
 752                                         ,SYS-DEF-STR-REP
 753                                         <> <> <>
 754                                         ,SYS-INFINITY
 755                                         ,SYS-INFINITY
 756                                         ,SYS-INFINITY
 757                                         ,SYS-INFINITY
 758                                         <> <> <> <>  <> <> <> <>
 759                                         <> <> <> <>  <> <> <> <>
 760                                         <> <> <> <>
 761                         > DBMS-OPTIONS>))
 762         #DECL ((DBMS-ENTRY) DBMS (OPTION-LIST) LIST (OPT) DBMS-OPTIONS)
 763         <MAPF   <>
 764                 <FUNCTION (O)
 765                   <COND (<TYPE? .O GLOBAL-OPS>
 766                          <PUT .OPT ,DB-GLOBAL-OPS .O>)
 767                         (<TYPE? .O DISPLAY-OPS>
 768                          <PUT .OPT ,DB-DISPLAY-OPS .O>)
 769                         (<TYPE? .O FIND-OPS>
 770                          <PUT .OPT ,DB-FIND-OPS .O>)
 771                         (<TYPE? .O QUANTIFIERS-OPS>
 772                          <PUT .OPT ,DB-QUANTIFIERS .O>)
 773                         (<TYPE? .O LIST>
 774                          <COND (<==? <1 .O> INT-BIT>
 775                                 <PUT .OPT ,DB-DEF-INT-BITS <2 .O>>)
 776                                (<==? <1 .O> INT-REP>
 777                                 <COND (<==? <2 .O> ONES>
 778                                         <PUT .OPT ,DB-DEF-INT-REP DB-ONES-COMP>)
 779                                       (<==? <2 .O> TWOS>
 780                                         <PUT .OPT ,DB-DEF-INT-REP DB-TWOS-COMP>)>)
 781                                (<==? <1 .O> CHR-BIT>
 782                                 <PUT .OPT ,DB-DEF-STR-BITS <2 .O>>)
 783                                (<==? <1 .O> CHR-REP>
 784                                 <COND (<==? <2 .O> ASCII>
 785                                         <PUT .OPT ,DB-DEF-STR-REP DB-ASCII>)
 786                                       (<==? <2 .O> BCD>
 787                                         <PUT .OPT ,DB-DEF-STR-REP DB-BCD>)>)
 788                                (<==? <1 .O> MAX-PRED>
 789                                 <PUT .OPT ,DB-MAX-NON-QUANT-ITER <2 .O>>)
 790                                (<==? <1 .O> MAX-QPRED>
 791                                 <PUT .OPT ,DB-MAX-QUANT-ITER <2 .O>>)
 792                                (<==? <1 .O> MAX-QREL>
 793                                 <PUT .OPT ,DB-MAX-QUANT-REL <2 .O>>)
 794                                (<==? <1 .O> PRED-OPTN>
 795                                 <MAPF <>
 796                                  <FUNCTION (O)
 797                                   <COND(<TYPE? .O ARITHMETIC-OPS>
 798                                         <PUT .OPT ,DB-ARITH-OPS .O>)
 799                                        (<TYPE? .O COMPARE-OPS>
 800                                         <PUT .OPT ,DB-COMPARE-OPS .O>)
 801                                        (<TYPE? .O LOGICAL-OPS>
 802                                         <PUT .OPT ,DB-LOG-OPS .O>)
 803                                        (<TYPE? .O QUANTIFIED-OPS>
 804                                         <PUT .OPT ,DB-QUANT-REL .O>)
 805                                        (<TYPE? .O RELATIONAL-OPS>
 806                                         <PUT .OPT ,DB-REL-OPS .O>)
 807                                        (<AND <TYPE? .O LIST>
 808                                              <==? <1 .O> EXIST-OPS>>
 809                                         <PUT .OPT ,DB-EXIST-OPS <2 .O>>)
 810                                        (<==? .O ACCESS>
 811                                         <PUT .OPT ,DB-AP-REQUIRED T>)
 812                                        (<==? .O RESTRICTED>
 813                                         <PUT .OPT ,DB-AP-ONLY T>)
 814                                        (<FATAL-ERROR "DIR-DBMS-OPTIONS: Unknown option" .O>)>>
 815                                 <2 .O>>)
 816                                (<==? <1 .O> QPRED-OPTN>
 817                                 <MAPF <>
 818                                  <FUNCTION (O)
 819                                   <COND(<TYPE? .O ARITHMETIC-OPS>
 820                                         <PUT .OPT ,DB-QP-ARITH-OPS .O>)
 821                                        (<TYPE? .O COMPARE-OPS>
 822                                         <PUT .OPT ,DB-QP-COMPARE-OPS .O>)
 823                                        (<TYPE? .O LOGICAL-OPS>
 824                                         <PUT .OPT ,DB-QP-LOG-OPS .O>)
 825                                        (<TYPE? .O QUANTIFIED-OPS>
 826                                         <PUT .OPT ,DB-QP-QUANT-REL .O>)
 827                                        (<TYPE? .O RELATIONAL-OPS>
 828                                         <PUT .OPT ,DB-QP-REL-OPS .O>)
 829                                        (<AND <TYPE? .O LIST>
 830                                              <==? <1 .O> EXIST-OPS>>
 831                                         <PUT .OPT ,DB-QP-EXIST-OPS <2 .O>>)
 832                                        (<==? .O ACCESS>
 833                                         <PUT .OPT ,DB-QP-AP-REQUIRED T>)
 834                                        (<==? .O RESTRICTED>
 835                                         <PUT .OPT ,DB-QP-AP-ONLY T>)
 836                                        (<FATAL-ERROR "DIR-DBMS-OPTIONS: Unknown option" .O>)>>
 837                                 <2 .O>>)
 838                                (<FATAL-ERROR "DIR-DBMS-OPTIONS: Unknown option" .O>)>)
 839                         (<==? .O MULTIPLE>
 840                          <PUT .OPT ,DB-MULTIPLE-ITER T>)
 841                         (<==? .O PROPAGATE>
 842                          <PUT .OPT ,DB-RESTRICT-PROP T>)
 843                         (<==? .O STRICT>
 844                          <PUT .OPT ,DB-STRICT-NESTING-ONLY T>)
 845                         (<FATAL-ERROR "DIR-DBMS-OPTIONS: Unknown option" .O>)>>
 846                 .OPTION-LIST>
 847         <PUT .DBMS-ENTRY ,DB-OPTIONS .OPT>>
 848 ;"\f"
 849 ;"DIR-DBMS-TABLE builds the fixed portion of a DBMS-TABLE entry.
 850   Production: LOCAL NODE IS
 851                 LOCAL SCHEMA IS identifier
 852                 DBMS IS identifier
 853                 HOST IS identifier
 854                 LDI IS procedure_name ldi_choice  "
 855
 856 <DEFINE DIR-DBMS-TABLE (A B C D E F SCHEMA-NAME H I SYS-NAME K L M SYS-TYPE
 857                         O P HOST R S PROC-NAME LDI)
 858         #DECL ((SCHEMA-NAME SYS-NAME HOST) IDENTIFIER (SYS-TYPE) ATOM
 859                (PROC-NAME) STRING (LDI) LDI-DATA)
 860         <PUT .LDI ,LDI-PROC-NAME .PROC-NAME>
 861         <CHTYPE [ <ID-NAME .SCHEMA-NAME>
 862                   <ID-NAME .SYS-NAME>
 863                   .SYS-TYPE
 864                   <ID-NAME .HOST>
 865                   .LDI
 866                   <> ] DBMS>>
 867
 868
 869
 870
 871 ;"DIR-DELETE-DB deletes a database specification from the schema directory.
 872   Production: DELETE DATABASE identifier ;  "
 873
 874 <DEFINE DIR-DELETE-DB (X Y ID Z)
 875         #DECL ((ID) IDENTIFIER)
 876         <ERR "Not implemented yet">
 877         <>>
 878
 879
 880
 881
 882 ;"DIR-DELETE-DBMS deletes a DBMS specification from the schema directory.
 883   Production: DELETE DBMS identifier ;  "
 884
 885 <DEFINE DIR-DELETE-DBMS (X Y ID Z)
 886         #DECL ((ID) IDENTIFIER)
 887         <ERR "Not implemented yet">
 888         <>>
 889 ;"\f"
 890 ;"DIR-DELETE-DIR deletes the schema directory.
 891   Production: DELETE DIRECTORY ;  "
 892
 893 <DEFINE DIR-DELETE-DIR (X Y Z)
 894         <SETG SCHEMA-DIR <CHTYPE <IVECTOR 3 '<VECTOR>> DIRECTORY>> ;"poof"
 895         <RENAME ,DIRECTORY-FILE-NAME> ;"Delete the disk file, too"
 896         <WRITE-DIRECTORY>
 897         <INITIALIZE-DIRECTORY>> ;"Read it back in and init various ptrs"
 898
 899
 900
 901
 902
 903 ;"DIR-DEMO-CMD is called when a demo command is recognized
 904   Production:  demo_command  "
 905
 906 <DEFINE DIR-DEMO-CMD (STRUCT)
 907         #DECL ((STRUCT) ATOM)
 908         <CHTYPE [.STRUCT] DEMO-CMD>>
 909
 910
 911
 912
 913 ;"DIR-DEMO-OFF returns the keyword DEMO-OFF
 914   Production: DEMO OFF ;  "
 915
 916 <DEFINE DIR-DEMO-OFF (X Y Z)
 917         DEMO-OFF>
 918
 919
 920
 921
 922 ;"DIR-DEMO-ON returns the keyword DEMO-ON
 923   Production: DEMO ON ;  "
 924
 925 <DEFINE DIR-DEMO-ON (X Y Z)
 926         DEMO-ON>
 927
 928
 929
 930
 931 ;"DIR-DIR-CMD changes the structure built while parsing a directory
 932   command to be a vector of type DIR-CMD.
 933   Production: directory_command  "
 934
 935 <DEFINE DIR-DIR-CMD (STRUCT)
 936         #DECL ((STRUCT) ANY)
 937         <CHTYPE [.STRUCT] DIR-CMD>>
 938
 939
 940
 941
 942
 943 ;"DIR-ENTITY-EXTENT creates a list containing an entity name and its
 944   associated mapping information plus and empty list since no function
 945   mapping was supplied.
 946   Production: EXTENT identifier IS db_entity_map db_extent_end "
 947
 948 <DEFINE DIR-ENTITY-EXTENT (X ENAME Y EMAP Z)
 949         #DECL ((ENAME) IDENTIFIER (EMAP) LIST)
 950         (<ID-NAME .ENAME> .EMAP ())>
 951
 952
 953
 954
 955 ;"\f"
 956 ;"DIR-ENTITY-FUNC-EXTENT creates a list containing an entity name its
 957   associated mapping info and its function mapping info.
 958   Production: EXTENT identifier IS db_entity_map db_func_map db_extent_end "
 959
 960 <DEFINE DIR-ENTITY-FUNC-EXTENT (X ENAME Y EMAP FMAP Z)
 961         #DECL ((ENAME) IDENTIFIER (EMAP FMAP) LIST)
 962         (<ID-NAME .ENAME> .EMAP .FMAP)>
 963
 964
 965
 966
 967
 968 ;"DIR-ENTITY-PRED-OPTN returns the predicate options of the entity
 969   Production: RESTRICTED predicate_option_list  "
 970
 971 <DEFINE DIR-ENTITY-PRED-OPTN (X OPTN)
 972         #DECL ( (OPTN) LIST)
 973         (PRED-OPTN .OPTN)>
 974
 975
 976
 977
 978 ;"DIR-ENTITY-TYPE creates a two element list containing the entity
 979   name and a list describing its functions.
 980   Production: TYPE entity_name IS ENTITY entity_body entity_end ;  "
 981
 982 <DEFINE DIR-ENTITY-TYPE (W ENAME X Y EBODY Z V)
 983         #DECL ((ENAME) IDENTIFIER (EBODY) LIST)
 984         (<ID-NAME .ENAME> .EBODY)>
 985
 986
 987 ;"Production: TYPE entity_name IS ENTITY entity_end ; "
 988 <DEFINE DIR-ENTITY-TYPE-EMPTY(W ENAME X Y Z V)
 989         #DECL((ENAME) IDENTIFIER)
 990         (<ID-NAME .ENAME> () )
 991 >
 992
 993
 994 ;"DIR-FCN-DEF adds the function name to an ENTITY-FUNC vector
 995   Production: function_name : value_format ;  "
 996
 997 <DEFINE DIR-FCN-DEF (ID X F Y)
 998         #DECL ((ID) IDENTIFIER (F) ENTITY-FUNC)
 999         <PUT .F ,F-NAME <ID-NAME .ID>>>
1000
1001
1002
1003
1004 ;"DIR-FLUSH-DIR deletes the schema directory in memory only.
1005   Production:   FLUSH DIRECTORY ;  or
1006                 FLUSH ;         "
1007
1008 <DEFINE DIR-FLUSH-DIR (X Y "OPT" Z "AUX" FOO)
1009         #DECL ((FOO) <OR ATOM FALSE>)
1010         <SET FOO ,DONT-RELOAD-DIR>
1011         <SETG DONT-RELOAD-DIR T>
1012         <SETG SCHEMA-DIR <CHTYPE <IVECTOR 3 '<VECTOR>> DIRECTORY>> ;"poof"
1013         <INITIALIZE-DIRECTORY>
1014         <SETG DONT-RELOAD-DIR .FOO>
1015 >
1016
1017
1018
1019
1020 ;"DIR-FOP-CALC returns the keyword FIND-CALC.
1021   Production: CALC  "
1022
1023 <DEFINE DIR-FOP-CALC (X)
1024         FIND-CALC>
1025
1026 ;"DIR-FOP-CUR returns the keyword FIND-CUR.
1027   Production: CURRENT  "
1028
1029 <DEFINE DIR-FOP-CUR (X)
1030         FIND-CUR>
1031
1032 ;"DIR-FOP-KEY returns the keyword FIND-KEY.
1033   Production: DATABASE_KEY  "
1034
1035 <DEFINE DIR-FOP-KEY (X)
1036         FIND-KEY>
1037
1038 ;"DIR-FOP-OWN returns the keyword FIND-OWN.
1039   Production: OWNER  "
1040
1041 <DEFINE DIR-FOP-OWN (X)
1042         FIND-OWN>
1043
1044 ;"DIR-FOP-POS returns the keyword FIND-POS.
1045   Production: POSITIONAL  "
1046
1047 <DEFINE DIR-FOP-POS (X)
1048         FIND-POS>
1049
1050 ;"DIR-FOP-USE-CUR returns the keyword FIND-USE-CUR.
1051   Production: USING_CURRENT  "
1052
1053 <DEFINE DIR-FOP-USE-CUR (X)
1054         FIND-USE-CUR>
1055
1056 ;"DIR-FOP-USE-NCUR returns the keyword FIND-USE-NCUR.
1057   Production: USING_NON_CURRENT  "
1058
1059 <DEFINE DIR-FOP-USE-NCUR (X)
1060         FIND-USE-NCUR>
1061
1062
1063 ;"DIR-FUNC-AOPS returns a list containing the arithmetic operators
1064   supported for the specific function.
1065   Production: RESTRICTED TO ARITHMETIC OPERATIONS supported_arith_list ;  "
1066
1067 <DEFINE DIR-FUNC-AOPS (V W X Y OPS Z)
1068         #DECL ((OPS) LIST)
1069         (AOPS <DIR-SUPPORTED-AOPS X Y Z .OPS>)>
1070
1071
1072
1073
1074 ;"DIR-FUNC-EXTENT creates a list containing the function name and its
1075   associated mapping information.
1076   Production: identifier IS db_func_map  "
1077
1078 <DEFINE DIR-FUNC-EXTENT (FNAME X MAPPING)
1079         #DECL ((FNAME) IDENTIFIER (MAPPING) LIST)
1080         (<ID-NAME .FNAME> .MAPPING)>
1081
1082
1083
1084
1085 ;"DIR-FUNC-ROPS returns a list containing the relational operators
1086   supported for the specific function.
1087   Production: RESTRICTED TO RELATIONAL OPERATIONS supported_rel_list ;  "
1088
1089 <DEFINE DIR-FUNC-ROPS (V W X Y OPS Z)
1090         #DECL ((OPS) LIST)
1091         (ROPS <DIR-SUPPORTED-ROPS X Y Z .OPS>)>
1092 ;"\f"
1093
1094
1095
1096
1097 ;"DIR-INT-BITS returns a list containing the keyword INT-BIT and
1098   the default bit size for integers.
1099   Production: DEFAULT INTEGER BIT SIZE IS number  "
1100
1101 <DEFINE DIR-INT-BITS (V W X Y Z BIT-SIZE)
1102         #DECL ((BIT-SIZE) FIX)
1103         (INT-BIT .BIT-SIZE)>
1104
1105
1106
1107
1108
1109 ;"DIR-INT-REP returns a list containing the keyword INT-REP and
1110   the default representation for integers.
1111   Production: DEFAULT INTEGER REP IS representation  "
1112
1113 <DEFINE DIR-INT-REP (W X Y Z VREP)
1114         #DECL ((VREP) ATOM)
1115         (INT-REP .VREP)>
1116
1117
1118
1119
1120 ;"DIR-INT-STR creates a list containing the keyword INT-STR and
1121   the min/max number of characters in the integer string.
1122   Production: STORED AS STRING ( number_characters )  "
1123
1124 <DEFINE DIR-INT-STR (X Y Z V MIN-MAX W)
1125         #DECL ((MIN-MAX) LIST)
1126         (INT-STR <1 .MIN-MAX> <2 .MIN-MAX>)>
1127
1128
1129
1130
1131 ;"DIR-KEY returns the key specification for the entity.
1132   Production: KEY key_spec ;  "
1133
1134 <DEFINE DIR-KEY (Y KEY-SPEC Z)
1135         #DECL ( (KEY-SPEC) <OR ATOM LIST>)
1136         <COND (<TYPE? .KEY-SPEC ATOM>
1137                 (KEY ()) ) ;"DATABASE_KEY"
1138               (ELSE
1139                 (KEY .KEY-SPEC) )>>
1140
1141
1142
1143 ;"DIR-LOCAL-LDI builds an LDI-DATA vector containing information
1144   about a local LDI.
1145   Production: LOCAL  "
1146
1147 <DEFINE DIR-LOCAL-LDI (X)
1148         <CHTYPE <VECTOR T
1149                         <>
1150                         <>
1151                         <>> LDI-DATA>>
1152
1153
1154
1155
1156 ;"DIR-MAX-ONLY creates a list containing the range of a STRING.
1157   Production: number  "
1158
1159 <DEFINE DIR-MAX-ONLY (VMAX)
1160         #DECL ((VMAX) FIX)
1161         (.VMAX .VMAX)>
1162
1163
1164
1165 ;"DIR-MAX-PRED returns the non-quantified iteration predicate limit.
1166   Production: MAXIMUM OF number NON_QUANTIFIED ITERATION PREDICATES "
1167
1168 <DEFINE DIR-MAX-PRED (V W NUM X Y Z)
1169         #DECL ( (NUM) FIX)
1170         (MAX-PRED .NUM)>
1171
1172
1173
1174
1175 ;"DIR-MAX-QPRED returns the quantified iteration predicate limit.
1176   Production: MAXIMUM OF number QUANTIFIED ITERATION PREDICATES "
1177
1178 <DEFINE DIR-MAX-QPRED (V W NUM X Y Z)
1179         #DECL ( (NUM) FIX)
1180         (MAX-QPRED .NUM)>
1181
1182
1183
1184
1185 ;"DIR-MAX-QREL returns the quantified relation within a predicate limit.
1186   Production: MAXIMUM OF number QUANTIFIED RELATIONS PER ITERATION "
1187
1188 <DEFINE DIR-MAX-QREL (V W NUM X Y Z U)
1189         #DECL ( (NUM) FIX)
1190         (MAX-QREL .NUM)>
1191
1192
1193
1194
1195 ;"DIR-MIN-MAX creates a list containing the range of a STRING.
1196   Production: number .. number  "
1197
1198 <DEFINE DIR-MIN-MAX (VMIN X VMAX)
1199         #DECL ((VMIN VMAX) FIX)
1200         (.VMIN .VMAX)>
1201
1202
1203
1204
1205 ;"DIR-NO-AOPS is called to process a declaration of no arithmetic ops.
1206   Production: RESTRICTED TO NO ARITHMETIC OPERATINS ;  "
1207
1208 <DEFINE DIR-NO-AOPS (U V W X Y Z)
1209         (AOPS <DIR-SUPPORTED-AOPS X Y Z '()>) >
1210
1211
1212
1213
1214 ;"DIR-NO-QUANT is called for an entity which cannot be the domain
1215   of a quantification.
1216   Production: TO NO QUANTIFICATION ;  "
1217
1218 <DEFINE DIR-NO-QUANT (W X Y Z)
1219         (NO-QUANT)>
1220
1221
1222
1223
1224 ;"DIR-NO-ROPS is called to process a declaration of no relational ops.
1225   Production: RESTRICTED TO NO RELATIONAL OPERATINS ;  "
1226
1227 <DEFINE DIR-NO-ROPS (U V W X Y Z)
1228         (ROPS <DIR-SUPPORTED-ROPS X Y Z '()>) >
1229
1230
1231
1232
1233 ;"DIR-OPTIONAL is called when a partial function is recognized.
1234   Production: range_type PARTIAL  "
1235
1236 <DEFINE DIR-OPTIONAL (F)
1237         #DECL ((F) ENTITY-FUNC)
1238         .F>     ;"No-op for now"
1239
1240
1241
1242
1243
1244 ;"DIR-OWNER creates a list containing the keyword OWNED and a list
1245   of entity types that are owners.
1246   Production: OWNED BY entity_list ;  "
1247
1248 <DEFINE DIR-OWNER (X Y EL Z)
1249         #DECL ((EL) LIST)
1250         (OWNED .EL)>
1251
1252
1253
1254
1255 ;"\f"
1256 ;"DIR-PRED-ITER returns information on the type of predicates
1257   permitted when an entity is the domain of an iteration.
1258   Production: WHEN DOMAIN OF ITERATION TO type PREDICATES ;  "
1259
1260 <DEFINE DIR-PRED-ITER (S U V W X TYP Y Z)
1261         #DECL ( (TYP) LIST)
1262         (ITER-DOMAIN <DIR-SUPPORTED-PRED-TYPES .TYP>)>
1263
1264
1265
1266
1267 ;"DIR-PRED-OPTN returns the predicate options of the dbms
1268   Production: WITHIN NON_QUANTIFIED PREDICATES predicate_option_list  "
1269
1270 <DEFINE DIR-PRED-OPTN (X Y Z OPTN)
1271         #DECL ( (OPTN) LIST)
1272         (PRED-OPTN .OPTN)>
1273
1274
1275
1276
1277 ;"DIR-PRED-QUANT returns information on the type of predicates
1278   permitted when an entity is the domain of a quantification.
1279   Production: WHEN DOMAIN OF QUANTIFICATION TO type PREDICATES ;  "
1280
1281 <DEFINE DIR-PRED-QUANT (S U V W X TYP Y Z)
1282         #DECL ( (TYP) LIST)
1283         (QUANT-DOMAIN <DIR-SUPPORTED-PRED-TYPES .TYP>)>
1284
1285
1286
1287
1288 ;"DIR-PRINT-CH creates a list containing the keyword PRINTING and
1289   the max number of characters required to print a function value.
1290   Production: number PRINTING CHARS  "
1291
1292 <DEFINE DIR-PRINT-CH (NUM X Y)
1293         #DECL ((NUM) FIX)
1294         (PRINTING .NUM)>
1295
1296
1297
1298
1299
1300 ;"DIR-PRINT-DB pretty prints a database or view.
1301   Production: PRINT DATABASE identifier ;  "
1302
1303 <DEFINE DIR-PRINT-DB (X Y DNAME Z "AUX" (I 0))
1304         #DECL ((DNAME) IDENTIFIER (I) FIX)
1305         <COND (<MAPF <>
1306                      <FUNCTION (V)
1307                         #DECL ((V) VIEW)
1308                         <SET I <+ .I 1>>
1309                         <COND (<==? <V-NAME .V> <ID-NAME .DNAME>>
1310                                 <PP-DATABASE .I>
1311                                 <MAPLEAVE>)>>
1312                      ,VIEW-TAB>)
1313               (<ERR <STRING "Database or view " <SPNAME <ID-NAME .DNAME>>
1314                                 " is undefined.">>)>>
1315
1316
1317
1318
1319
1320 ;"DIR-PRINT-DBMS pretty prints a DBMS table entry.
1321   Production: PRINT DBMS identifier ;  "
1322
1323 <DEFINE DIR-PRINT-DBMS (X Y SYS-NAME Z)
1324         #DECL ((SYS-NAME) IDENTIFIER)
1325         <COND (<MAPF <>
1326                      <FUNCTION (D)
1327                         #DECL ((D) DBMS)
1328                         <COND (<==? <DB-SCHEMA-NAME .D> <ID-NAME .SYS-NAME>>
1329                                 <PP-DBMS .D>
1330                                 <MAPLEAVE>)>>
1331                      ,DBMS-TAB>)
1332               (<ERR <STRING "DBMS " <SPNAME <ID-NAME .SYS-NAME>>
1333                                 " is undefined.">>)>>
1334
1335
1336
1337
1338 ;"\f"
1339 ;"DIR-PRINT-DIR pretty prints the schema directory.
1340   Production: PRINT DIRECTORY ;  "
1341
1342 <DEFINE DIR-PRINT-DIR (X Y Z)
1343         <PP-DIR>
1344         <>>     ;"Return false to skip context analysis"
1345
1346
1347
1348
1349
1350 ;"DIR-PRINT-ET prints an entity type table entry.  Note that only
1351   the current view context is searched.
1352   Production: PRINT ENTITY TYPE identifier ;  "
1353
1354 <DEFINE DIR-PRINT-ET (W X Y ENAME Z)
1355         #DECL ((ENAME) IDENTIFIER)
1356         <COND (<FIND-ENTITY-TYPE .ENAME>
1357                 <PP-ENTITY-TYPE <<ID-ETID .ENAME> ,ET-TABLE>>)>>
1358
1359
1360
1361
1362 ;"\f"
1363 ;"DIR-QPRED-OPTN returns the quantified predicate optins.
1364   Production: WITHIN QUANTIFIED PREDICATES predicate_option_list  "
1365
1366 <DEFINE DIR-QPRED-OPTN (X Y Z OPTN)
1367         #DECL ( (OPTN) LIST)
1368         (QPRED-OPTN .OPTN)>
1369 ;"\f"
1370 ;"DIR-RANGE-ENTITY creates a default ENTITY-FUNC vector for a
1371   function whose range is entity.  Elements in the vector may
1372   be changed as more is learned about the function.
1373   Production: entity_name  "
1374
1375 <DEFINE DIR-RANGE-ENTITY (E)
1376         #DECL ((E) IDENTIFIER)
1377         <CHTYPE [<> F-ENTITY F-SV <ID-NAME .E> <> <> <>] ENTITY-FUNC>>
1378
1379
1380
1381
1382 ;"DIR-RANGE-INTEGER creates a default ENTITY-FUNC vector for a
1383   function whose range is integer.  Elements in the vector may
1384   be changed as more is learned about the function.
1385   Production: INTEGER  "
1386
1387 <DEFINE DIR-RANGE-INTEGER (X)
1388         <CHTYPE <VECTOR <> F-INTEGER F-SV -34359738366 34359738367 <> <>>
1389                  ENTITY-FUNC>>
1390
1391
1392
1393 ;"DIR-RANGE-STR creates a default ENTITY-FUNC vector for a
1394   function whose range is string.  Elements in the vector may
1395   be changed as more is learned about the function.
1396   Production: STRING ( number_characters )  "
1397
1398 <DEFINE DIR-RANGE-STR (X Y MIN-MAX Z)
1399         #DECL ((MIN-MAX) LIST)
1400         <CHTYPE [<> F-STRING F-SV <1 .MIN-MAX> <2 .MIN-MAX> <> <>]
1401                 ENTITY-FUNC>>
1402
1403
1404
1405
1406 ;"DIR-READ-DIR reads the schema directory from disk.
1407   (24-jun-81) Note that reading the directory with READ-DIRECTORY
1408   is, in fact, useless because the atoms ET-TABLE, etc. which all
1409   of Multibase uses are not rebound.  The directory must be read
1410   using INITIALIZE-DIRECTORY, which not only reads the directory,
1411   but also rebinds these atoms.
1412   Production: READ DIRECTORY ;  "
1413
1414 <DEFINE DIR-READ-DIR (X Y Z) <INITIALIZE-DIRECTORY>>
1415 <DEFINE DIR-READ-DIR-FILE (X Y FILE Z "AUX" ANS)
1416         #DECL ((FILE) STRING (ANS) <OR ATOM FALSE>)
1417         <COND (<SET ANS <FILE-EXISTS? .FILE>>
1418                 <SETG DIRECTORY-FILE-NAME .FILE>
1419                 <INITIALIZE-DIRECTORY>)
1420               (ELSE
1421                 <ERR "File does not exist: " <1 .ANS>>
1422                 <>)>
1423 >
1424
1425
1426
1427
1428 ;"DIR-REMOTE-LDI builds an LDI-DATA vector containing information
1429   about a remote LDI.
1430   Production: REMOTE host socket  "
1431
1432 <DEFINE DIR-REMOTE-LDI (X HOST SOCKET)
1433         #DECL ((HOST) IDENTIFIER (SOCKET) FIX)
1434         <CHTYPE [ <>
1435                   <>
1436                   <ID-NAME .HOST>
1437                   .SOCKET ] LDI-DATA>>
1438
1439
1440
1441
1442 ;"DIR-REPEAT-GRP creates a list containing the keyword REPEAT.
1443   Production: REPEATING GROUP  "
1444
1445 <DEFINE DIR-REPEAT-GRP (X Y)
1446         '(REPEAT)>
1447
1448
1449
1450 ;"\f"
1451
1452
1453 ;"DIR-SET creates a list containing the keyword SET.
1454   Production: SET  "
1455
1456 <DEFINE DIR-SET (X)
1457         '(SET)>
1458
1459
1460
1461
1462 ;"DIR-SET-OF changes the range of a function to be multi-valued.
1463   Production: SET OF range_type  "
1464
1465 <DEFINE DIR-SET-OF (X Y F)
1466         #DECL ((F) ENTITY-FUNC)
1467         <PUT .F ,F-RANGE F-MV>>
1468
1469
1470
1471 ;"DIR-SPELLED creates a list with the keyword SPELLED and a
1472   string.
1473   Production: SPELLED character_string ;  "
1474
1475 <DEFINE DIR-SPELLED (X STR "OPT" (Z <>))
1476         #DECL ((STR) STRING)
1477         (SPELLED .STR)>
1478
1479
1480 ;"Production: WHEN SPELLED string ; "
1481
1482 <DEFINE DIR-SPELLED-2 (X Y STR "OPT" (Z <>))
1483         #DECL ((STR) STRING)
1484         (SPELLED .STR)>
1485
1486
1487
1488
1489
1490   ;"Production: CONTAIN entity_name IN entity-list ;  "
1491
1492 <DEFINE DIR-SUPERTYPE (X ID Y EL Z)
1493         #DECL ((EL) LIST (ID) IDENTIFIER)
1494         <CHTYPE [.ID .EL] CONTAIN>
1495 >
1496
1497
1498
1499 ;"\f"
1500 ;"DIR-SUPPORTED-AOPS creates a vector describing the arithmetic operations
1501   supported by a dbms.
1502   Production: SUPPORTED ARITHMETIC OPERATIONS supported_arith_list ;  "
1503
1504 <DEFINE DIR-SUPPORTED-AOPS (X Y Z AOP-LIST "OPT" S)
1505         #DECL ( (AOP-LIST) LIST)
1506         <CHTYPE [       <IN-LIST? '(ALL)        .AOP-LIST>
1507                         <IN-LIST? '(+)          .AOP-LIST>
1508                         <IN-LIST? '(-)          .AOP-LIST>
1509                         <IN-LIST? '(*)          .AOP-LIST>
1510                         <IN-LIST? '(/)          .AOP-LIST>
1511                         <IN-LIST? '(&)          .AOP-LIST>
1512                 ] ARITHMETIC-OPS>
1513 >
1514
1515
1516 ;"DIR-SUPPORTED-COPS creates a vector describing compare operations
1517   supported by a DBMS.
1518   Production: SUPPORTED COMPARE OPERATIONS supported_comp_list ;  "
1519
1520 <DEFINE DIR-SUPPORTED-COPS (X Y Z COP-LIST)
1521         #DECL ((COP-LIST) LIST)
1522         <CHTYPE [ <IN-LIST? '(ALL)              .COP-LIST>
1523                   <IN-LIST? '(CONSTANT)         .COP-LIST>
1524                   <IN-LIST? '(FIELD)            .COP-LIST>
1525                   <IN-LIST? '(EXPRESSION)       .COP-LIST> ] COMPARE-OPS>>
1526
1527
1528
1529
1530 ;"DIR-SUPPORTED-DOPS creates a vector describing display operations
1531   supported by a DBMS.
1532   Production: SUPPORTED DISPLAY OPERATIONS supported_comp_list ;  "
1533
1534 <DEFINE DIR-SUPPORTED-DOPS (X Y Z COP-LIST)
1535         #DECL ((COP-LIST) LIST)
1536         <CHTYPE [ <IN-LIST? '(ALL)              .COP-LIST>
1537                   <IN-LIST? '(CONSTANT)         .COP-LIST>
1538                   <IN-LIST? '(FIELD)            .COP-LIST>
1539                   <IN-LIST? '(EXPRESSION)       .COP-LIST> ] DISPLAY-OPS>>
1540
1541
1542
1543
1544 ;"DIR-SUPPORTED-EOPS creates a description of the existential logical
1545   operations supported by a dbms.
1546   Production: SUPPORTED EXISTENTIAL OPERATIONS supported_log_list  "
1547
1548 <DEFINE DIR-SUPPORTED-EOPS (X Y Z LOP-LIST)
1549         #DECL ( (LOP-LIST) LIST)
1550         (EXIST-OPS <DIR-SUPPORTED-LOPS X Y Z .LOP-LIST>)>
1551
1552
1553
1554
1555 ;"DIR-SUPPORTED-FOPS creates a vector describing FIND verbs supported
1556   by a CODASYL DBMS.
1557   Production: SUPPORTED FIND VERBS supported_find_list  "
1558
1559 <DEFINE DIR-SUPPORTED-FOPS (X Y Z FOP-LIST)
1560         #DECL ((FOP-LIST) LIST)
1561         <CHTYPE [ <IN-LIST? '(FIND-KEY)         .FOP-LIST>
1562                   <IN-LIST? '(FIND-CUR)         .FOP-LIST>
1563                   <IN-LIST? '(FIND-POS)         .FOP-LIST>
1564                   <IN-LIST? '(FIND-OWN)         .FOP-LIST>
1565                   <IN-LIST? '(FIND-CALC)        .FOP-LIST>
1566                   <IN-LIST? '(FIND-USE-CUR)     .FOP-LIST>
1567                   <IN-LIST? '(FIND-USE-NCUR)    .FOP-LIST>
1568                 ] FIND-OPS>>
1569
1570
1571
1572
1573 ;"DIR-SUPPORTED-GOPS creates a vector describing global
1574   optimizations supported by a DBMS.
1575   Production: SUPPORTED GLOBAL OPTIMIZATIONS global_optimization_list  "
1576
1577 <DEFINE DIR-SUPPORTED-GOPS (X Y Z GOP-LIST)
1578         #DECL ((GOP-LIST) LIST)
1579         <CHTYPE [ <IN-LIST? '(ALL)      .GOP-LIST>
1580                   <IN-LIST? '(CREATE)   .GOP-LIST>
1581                   <IN-LIST? '(REFERENCE) .GOP-LIST> ] GLOBAL-OPS>>
1582
1583
1584
1585
1586 ;"DIR-SUPPORTED-LOPS creates a vector describing logical
1587   operations supported by a DBMS.
1588   Production: SUPPORTED LOGICAL OPERATIONS supported_log_list  "
1589
1590 <DEFINE DIR-SUPPORTED-LOPS (X Y Z LOP-LIST)
1591         #DECL ((LOP-LIST) LIST)
1592         <CHTYPE [ <IN-LIST? '(ALL)      .LOP-LIST>
1593                   <IN-LIST? '(AND)      .LOP-LIST>
1594                   <IN-LIST? '(NOT)      .LOP-LIST>
1595                   <IN-LIST? '(OR)       .LOP-LIST>
1596                 ] LOGICAL-OPS>>
1597
1598
1599
1600
1601 ;"DIR-SUPPORTED-PRED-TYPES is an internal entry to decode allowable
1602   predicate types."
1603
1604 <DEFINE DIR-SUPPORTED-PRED-TYPES (TYP)
1605         #DECL ((TYP) LIST)
1606         <CHTYPE [       <IN-LIST? '(ALL)        .TYP>
1607                         <IN-LIST? '(NO)         .TYP>
1608                         <IN-LIST? '(QUANTIFIED) .TYP>
1609                         <IN-LIST? '(NON_QUANTIFIED) .TYP>
1610                 ] PREDICATE-TYPES>>
1611
1612
1613
1614
1615 ;"DIR-SUPPORTED-QOPS creates a vector describing the quantificatin operations
1616   supported by the dbms.
1617   Productin: SUPPORTED QUANTIFIED RELATIONS supported_quant_list  "
1618
1619 <DEFINE DIR-SUPPORTED-QOPS (X Y Z QOP-LIST)
1620         #DECL ( (QOP-LIST) LIST)
1621         <CHTYPE [       <IN-LIST? '(ALL)        .QOP-LIST>
1622                         <IN-LIST? '(NESTED)     .QOP-LIST>
1623                         <IN-LIST? '(PARALLEL)   .QOP-LIST>
1624                 ] QUANTIFIED-OPS>
1625 >
1626
1627
1628
1629
1630 ;"DIR-SUPPORTED-QNTS creates a vector describing the quantificatin operations
1631   supported by the dbms.
1632   Productin: SUPPORTED QUANTIFIERS supported_qnt_list  "
1633
1634 <DEFINE DIR-SUPPORTED-QNTS (X Y QOP-LIST)
1635         #DECL ( (QOP-LIST) LIST)
1636         <CHTYPE [       <IN-LIST? '(ALL)        .QOP-LIST>
1637                         <IN-LIST? '(SOME)       .QOP-LIST>
1638                         <IN-LIST? '(EVERY)      .QOP-LIST>
1639                         <IN-LIST? '(NO)         .QOP-LIST>
1640                 ] QUANTIFIERS-OPS>
1641 >
1642
1643
1644
1645
1646 ;"DIR-SUPPORTED-ROPS creates a vector describing relational
1647   operations supported by a DBMS.
1648   Production: SUPPORTED RELATIONAL OPERATIONS supported_rel_list  "
1649
1650 <DEFINE DIR-SUPPORTED-ROPS (X Y Z ROP-LIST "OPT" S)
1651         #DECL ((ROP-LIST) LIST)
1652         <CHTYPE [ <IN-LIST? '(ALL)      .ROP-LIST>
1653                   <IN-LIST? '(\>)       .ROP-LIST>
1654                   <IN-LIST? '(\<)       .ROP-LIST>
1655                   <IN-LIST? '(\<=)      .ROP-LIST>
1656                   <IN-LIST? '(\>=)      .ROP-LIST>
1657                   <IN-LIST? '(/=)       .ROP-LIST>
1658                   <IN-LIST? '(=)        .ROP-LIST>
1659                   <IN-LIST? '(AC)       .ROP-LIST>
1660                   <IN-LIST? '(ISIN)     .ROP-LIST>
1661                 ] RELATIONAL-OPS>>
1662
1663
1664
1665
1666 ;"\f"
1667 ;"DIR-SYS-EP creates a list containing the keyword SYS-EP.
1668   Production: SYSTEM ENTRY POINT ;  "
1669
1670 <DEFINE DIR-SYS-EP (W X Y Z)
1671         (SYS-EP ())>
1672
1673
1674
1675
1676 ;"DIR-SYS-EP-ACCESS creates a list containing the keyword ACCESS.
1677   Productin: BY ACCESS PATH ONLY ;  "
1678
1679 <DEFINE DIR-SYS-EP-ACCESS (V W X Y Z)
1680         (ACCESS)>
1681
1682
1683
1684 ;"DIR-SYS-EP-KEYS returns a list of key values to be used in
1685   iterating over a system-entry point.
1686   Productin: ITERATE USING KEYS key_list ;  "
1687
1688 <DEFINE DIR-SYS-EP-KEYS (W X Y KEYLIST Z)
1689         #DECL ( (KEYLIST) LIST)
1690         (KEYS <CHTYPE .KEYLIST KEY-LIST>)>
1691
1692
1693
1694
1695 ;"DIR-SYS-EP-OPTN creates a list containing the keyword SYS-EP and
1696   a list of options describing the system entry point.
1697   Production: SYSTEM ENTRY POINT sys_ep_clause  "
1698
1699 <DEFINE DIR-SYS-EP-OPTN (W X Y OPTN)
1700         #DECL ((OPTN) LIST)
1701         (SYS-EP .OPTN)>
1702
1703
1704
1705
1706 ;"DIR-SYS-EP-SET passes the system set name for a system entry point
1707   Productin:  VIA character_string ;  "
1708
1709 <DEFINE DIR-SYS-EP-SET (Y SET-NAME Z)
1710         #DECL ( (SET-NAME) STRING)
1711         (SETNAME .SET-NAME)>
1712
1713
1714
1715
1716 ;"\f"
1717 ;"DIR-VIEW-DEF changes the structure created by parsing a view
1718   definition command into a vector of type VIEW-DEF.
1719   Production: view_definition  "
1720
1721 <DEFINE DIR-VIEW-DEF (STRUCT)
1722         #DECL ((STRUCT) VECTOR)
1723         <CHTYPE [.STRUCT] VIEW-DEF>>
1724
1725
1726
1727
1728
1729 ;"DIR-VISIBLE processes the visible part of a view or database definition.
1730   A vector is created containing the view/db name, a slot that will be
1731   filled in later with the name specified on the END statement, the
1732   list of entity definitions, no constraints and a slot that may be
1733   filled in later with mapping info.
1734   Production: identifier IS group_of_entities  "
1735
1736 <DEFINE DIR-VISIBLE (DB-NAME X EL)
1737         #DECL ((DB-NAME) IDENTIFIER (EL) LIST)
1738         [<ID-NAME .DB-NAME> <> .EL <> <>]>
1739
1740
1741
1742 ;"DIR-VISIBLE-CONSTRAINTS is just like DIR-VISIBLE except that a
1743   list of constraints is added to the vector.
1744   Production: identifier IS group_of_entities constraint_list  "
1745
1746 <DEFINE DIR-VISIBLE-CONSTRAINTS (DB-NAME X EL CL)
1747         #DECL ((DB-NAME) IDENTIFIER (EL CL) LIST)
1748         [<ID-NAME .DB-NAME> <> .EL <> .CL]>
1749
1750
1751
1752
1753
1754 ;"DIR-WRITE-DIR copies the schema directory to disk.
1755   Production: WRITE DIRECTORY ;  "
1756
1757 <DEFINE DIR-WRITE-DIR (X Y Z) <WRITE-DIRECTORY>>
1758
1759
1760 <DEFINE DIR-WRITE-DIR-FILE (X Y FILE Z)
1761         #DECL ((FILE) STRING)
1762         <SETG DIRECTORY-FILE-NAME .FILE>
1763         <WRITE-DIRECTORY>>
1764 "\f"
1765 ;"FIND-ETID is used to lookup a given entity type name in a vector
1766   of ENTITY-TYPEs.  Returns the entity types ETID or false."
1767
1768 <DEFINE FIND-ETID (EV ENAME)
1769         #DECL ((EV) VECTOR (ENAME) ATOM)
1770         <MAPF   <>
1771                 <FUNCTION (E)
1772                         #DECL ((E) <OR FALSE ENTITY-TYPE>)
1773                         <COND (.E
1774                                 <COND (<==? <ET-NAME .E> .ENAME>
1775                                         <MAPLEAVE <ET-ETID .E>>)>)>>
1776                 .EV>>
1777
1778
1779
1780
1781 ;"FIND-FID is used to lookup a given function name in a vector
1782   of ENTITY-FUNCs.  Returns the function's FID or false."
1783
1784 <DEFINE FIND-FID (FV FNAME "AUX" (I 0))
1785         #DECL ((FV) VECTOR (FNAME) ATOM (I) FIX)
1786         <MAPF   <>
1787                 <FUNCTION (F)
1788                         #DECL ((F) ENTITY-FUNC)
1789                         <SET I <+ .I 1>>
1790                         <COND (<==? <F-NAME .F> .FNAME>
1791                                 <MAPLEAVE .I>)>>
1792                 .FV>>
1793 "\f"
1794 ;"Pretty print routines for directory data structures"
1795
1796 ;"PP-DATABASE pretty prints all entity types in a database or view."
1797
1798 <DEFINE PP-DATABASE (VID)
1799         #DECL ((VID) FIX)
1800         <MAPF   <>
1801                 <FUNCTION (E)
1802                         #DECL ((E) ENTITY-TYPE)
1803                         <COND (<==? <ET-VID .E> .VID>
1804                                 <PP-ENTITY-TYPE .E>)>>
1805                 ,ET-TABLE>>
1806 ;"\f"
1807 ;"PP-DBMS prints one entry in the DBMS-TABLE."
1808
1809 <DEFINE PP-DBMS (D "AUX" GOP DOP FOP (L <DB-LDI-DATA .D>)
1810                                              (O <DB-OPTIONS .D>))
1811         #DECL ((D) DBMS (L) LDI-DATA (O) <OR DBMS-OPTIONS FALSE>
1812                 (GOP) <OR GLOBAL-OPS FALSE>
1813                 (DOP) <OR DISPLAY-OPS FALSE>
1814                 (FOP) <OR FIND-OPS FALSE>)
1815         <TPRINC "Schema name: "> <PRINC <DB-SCHEMA-NAME .D>> <CRLF>
1816         <TPRINC "DB system name: "> <PRINC <DB-SYS-NAME .D>> <CRLF>
1817         <TPRINC "DB type: "> <PRINC <DB-SYS-TYPE .D>> <CRLF>
1818         <TPRINC "Host: "> <PRINC <DB-HOST .D>> <CRLF>
1819         <TPRINC "LDI procedure name: ">
1820         <PRIN1 <LDI-PROC-NAME .L>>
1821         <CRLF>
1822         <COND (<LDI-LOCAL .L>
1823                 <TTPRINC "LDI is local">
1824                 <CRLF>)
1825               (ELSE
1826                 <TTPRINC "LDI is remote host/socket: ">
1827                 <PRINC <LDI-HOST-NAME .L>>
1828                 <PRINC " ">
1829                 <PRINC <LDI-SOCKET .L>>
1830                 <CRLF>)>
1831         <COND (.O
1832                 <SET GOP <DB-GLOBAL-OPS .O>>
1833                 <SET FOP <DB-FIND-OPS .O>>
1834                 <SET DOP <DB-DISPLAY-OPS .O>>
1835         <COND (.DOP
1836                 <TPRINC "Supported display operations: ">
1837                 <COND (<DOP-ALL .DOP>
1838                         <PRINC "ALL ">)>
1839                 <COND (<DOP-CONSTANT .DOP>
1840                         <PRINC "CONSTANT ">)>
1841                 <COND (<DOP-FIELD .DOP>
1842                         <PRINC "FIELD ">)>
1843                 <COND (<DOP-EXP .DOP>
1844                         <PRINC "EXP">)>
1845                 <CRLF>)>
1846                 <COND (.GOP
1847                         <TPRINC "Supported global optimizations: ">
1848                         <COND (<GOP-ALL .GOP>
1849                                 <PRINC "ALL ">)>
1850                         <COND (<GOP-TEMP-FILE .GOP>
1851                                 <PRINC "TEMPORARY-FILES ">)>
1852                         <COND (<GOP-EXTERN-FILE .GOP>
1853                                 <PRINC "EXTERNAL-FILES ">)>
1854                         <CRLF>)>
1855                 <COND (.FOP
1856                         <TPRINC "Supported find verbs: ">
1857                         <COND (<FOP-KEY .FOP>
1858                                 <PRINC "DB_KEY ">)>
1859                         <COND (<FOP-CURRENT .FOP>
1860                                 <PRINC "CURRENT ">)>
1861                         <COND (<FOP-POSITIONAL .FOP>
1862                                 <PRINC "POSITIONAL ">)>
1863                         <COND (<FOP-OWNER .FOP>
1864                                 <PRINC "OWNER ">)>
1865                         <COND (<FOP-CALC .FOP>
1866                                 <PRINC "CALC ">)>
1867                         <COND (<FOP-USE-CUR .FOP>
1868                                 <PRINC "USING_CURRENT ">)>
1869                         <COND (<FOP-USE-NON-CUR .FOP>
1870                                 <PRINC "USING_NON_CURRENT ">)>
1871                         <CRLF>)>
1872                 <TPRINC "Max quantified predicates: ">
1873                         <PRINC <DB-MAX-QUANT-ITER .O>> <CRLF>
1874                 <TPRINC "Max non-quantified predicates: ">
1875                         <PRINC <DB-MAX-NON-QUANT-ITER .O>> <CRLF>
1876                 <TPRINC "Max quantified relations: ">
1877                         <PRINC <DB-MAX-QUANT-REL .O>> <CRLF>
1878                 <COND (<DB-STRICT-NESTING-ONLY .O>
1879                         <TPRINC "Strict nesting of entities required">
1880                         <CRLF>)>
1881                 <COND (<DB-MULTIPLE-ITER .O>
1882                         <TPRINC "Multiple iterations over entity supported">
1883                         <CRLF>)>
1884                 <COND (<DB-RESTRICT-PROP .O>
1885                         <TPRINC "Restrictions propagate to all occurrences">
1886                         <CRLF>)>
1887                 <TPRINC "In non-quantified predicates --"> <CRLF>
1888                 <PP-DBMS-PRED
1889                         <DB-ARITH-OPS .O>       <DB-COMPARE-OPS .O>
1890                         <DB-EXIST-OPS .O>       <DB-LOG-OPS .O>
1891                         <DB-QUANT-REL .O>       <DB-REL-OPS .O>
1892                         <DB-AP-REQUIRED .O>     <DB-AP-ONLY .O>
1893                         >
1894                 <CRLF>
1895                 <TPRINC "In quantified predicates --"> <CRLF>
1896                 <PP-DBMS-PRED
1897                         <DB-QP-ARITH-OPS .O>    <DB-QP-COMPARE-OPS .O>
1898                         <DB-QP-EXIST-OPS .O>    <DB-QP-LOG-OPS .O>
1899                         <DB-QP-QUANT-REL .O>    <DB-QP-REL-OPS .O>
1900                         <DB-QP-AP-REQUIRED .O>  <DB-QP-AP-ONLY .O>
1901                         >
1902                 <CRLF>
1903                 <TPRINC "Default integer bit size: ">
1904                         <PRINC <DB-DEF-INT-BITS .O>> <CRLF>
1905                 <TPRINC "Default integer representation: ">
1906                         <PRINC <DB-DEF-INT-REP .O>> <CRLF>
1907                 <TPRINC "Default character bit size: ">
1908                         <PRINC <DB-DEF-STR-BITS .O>> <CRLF>
1909                 <TPRINC "Default character representation: ">
1910                         <PRINC <DB-DEF-STR-REP .O>> <CRLF>)>>
1911 ;"\f"
1912 <DEFINE PP-DBMS-PRED (AOP COP EOP LOP QUAN ROP AP-R AP-O)
1913         #DECL ( (AOP)   <OR ARITHMETIC-OPS FALSE>
1914                 (COP)   <OR COMPARE-OPS FALSE>
1915                 (EOP LOP) <OR LOGICAL-OPS FALSE>
1916                 (QUAN)  <OR QUANTIFIED-OPS FALSE>
1917                 (REL)   <OR RELATIONAL-OPS FALSE>
1918                 (AP-R AP-O) <OR ATOM FALSE>
1919               )
1920         <COND (.AP-R
1921                 <TPRINC "Access path usage required"> <CRLF>)>
1922         <COND (.AP-O
1923                 <TPRINC "Use access paths only"> <CRLF>)>
1924         <COND (.AOP
1925                 <TPRINC "Supported arithmetic operations: ">
1926                 <COND (<AOP-ALL .AOP>
1927                         <PRINC "ALL ">)>
1928                 <COND (<AOP-PLUS .AOP>
1929                         <PRINC "PLUS ">)>
1930                 <COND (<AOP-MINUS .AOP>
1931                         <PRINC "MINUS ">)>
1932                 <COND (<AOP-MULTIPLY .AOP>
1933                         <PRINC "MULTIPLY ">)>
1934                 <COND (<AOP-DIVIDE .AOP>
1935                         <PRINC "DIVIDE ">)>
1936                 <COND (<AOP-CONCAT .AOP>
1937                         <PRINC "CONCATENATE ">)>
1938                 <CRLF>)>
1939         <COND (.ROP
1940                 <TPRINC "Supported relational operations: ">
1941                 <COND (<ROP-ALL .ROP>
1942                         <PRINC "ALL ">)>
1943                 <COND (<ROP-GT .ROP>
1944                         <PRINC "GT ">)>
1945                 <COND (<ROP-LT .ROP>
1946                         <PRINC "LT ">)>
1947                 <COND (<ROP-LE .ROP>
1948                         <PRINC "LE ">)>
1949                 <COND (<ROP-GE .ROP>
1950                         <PRINC "GE ">)>
1951                 <COND (<ROP-NE .ROP>
1952                         <PRINC "NE ">)>
1953                 <COND (<ROP-EQ .ROP>
1954                         <PRINC "EQ ">)>
1955                 <COND (<ROP-AC .ROP>
1956                         <PRINC "ALPHA-COLLATE ">)>
1957                 <COND (<ROP-ISIN .ROP>
1958                         <PRINC "ISIN ">)>
1959                 <CRLF>)>
1960         <COND (.LOP
1961                 <TPRINC "Supported logical operations: ">
1962                 <COND (<LOP-ALL .LOP>
1963                         <PRINC "ALL ">)>
1964                 <COND (<LOP-AND .LOP>
1965                         <PRINC "AND ">)>
1966                 <COND (<LOP-NOT .LOP>
1967                         <PRINC "NOT ">)>
1968                 <COND (<LOP-OR .LOP>
1969                         <PRINC "OR ">)>
1970                 <CRLF>)>
1971         <COND (.EOP
1972                 <TPRINC "Supported existential logical operations: ">
1973                 <COND (<LOP-ALL .EOP>
1974                         <PRINC "ALL ">)>
1975                 <COND (<LOP-AND .EOP>
1976                         <PRINC "AND ">)>
1977                 <COND (<LOP-NOT .EOP>
1978                         <PRINC "NOT ">)>
1979                 <COND (<LOP-OR .EOP>
1980                         <PRINC "OR ">)>
1981                 <CRLF>)>
1982         <COND (.COP
1983                 <TPRINC "Supported compare operations: ">
1984                 <COND (<COP-ALL .COP>
1985                         <PRINC "ALL ">)>
1986                 <COND (<COP-CONSTANT .COP>
1987                         <PRINC "CONSTANT ">)>
1988                 <COND (<COP-FIELD .COP>
1989                         <PRINC "FIELD ">)>
1990                 <COND (<COP-EXP .COP>
1991                         <PRINC "EXP">)>
1992                 <CRLF>)>
1993         <COND (.QUAN
1994                 <TPRINC "Supported quantified relations: ">
1995                 <COND (<QOP-ALL .QUAN>
1996                         <PRINC "ALL ">)>
1997                 <COND (<QOP-NESTED .QUAN>
1998                         <PRINC "NESTED ">)>
1999                 <COND (<QOP-PARALLEL .QUAN>
2000                         <PRINC "PARALLEL ">)>
2001                 <CRLF>)>
2002 >
2003 ;"\f"
2004 ;"PP-DBMS-TABLE pretty prints the DBMS-TABLE."
2005
2006 <DEFINE PP-DBMS-TABLE (DT "AUX" (I 0))
2007         #DECL ((DT) VECTOR (I) FIX)
2008         <CRLF> <PRINC "DBMS Table: "> <CRLF>
2009         <MAPF   <>
2010                 <FUNCTION (D)
2011                         <SET I <+ .I 1>>
2012                         <COND (.D
2013                                 <PRINC "  (">
2014                                 <PRINC .I>
2015                                 <PRINC ")">
2016                                 <PP-DBMS .D>
2017                                 <CRLF>)>>
2018                 .DT>>
2019 ;"\f"
2020 ;"PP-DIR pretty prints the entire schema directory."
2021
2022 <DEFINE PP-DIR ("AUX" V E D)
2023         #DECL ((V E D) <OR VECTOR FALSE>)
2024         <COND (<NOT <GASSIGNED? SCHEMA-DIR>>
2025                 <INITIALIZE-DIRECTORY>)>
2026         <SET V <VIEW-TABLE ,SCHEMA-DIR>>
2027         <SET E <ENTITY-TYPE-TABLE ,SCHEMA-DIR>>
2028         <SET D <DBMS-TABLE ,SCHEMA-DIR>>
2029         <CRLF> <PRINC "     *** Schema Directory ***"> <CRLF>
2030         <COND (<AND .V
2031                     <NOT <EMPTY? .V>>>
2032                 <PP-VIEW-TABLE .V> <CRLF>)
2033               (ELSE
2034                 <PRINC "View table is empty"> <CRLF>)>
2035         <COND (<AND .E
2036                     <NOT <EMPTY? .E>>>
2037                 <PP-ENTITY-TYPE-TABLE .E> <CRLF>)
2038               (ELSE
2039                 <PRINC "Entity Type table is empty"> <CRLF>)>
2040         <COND (<AND .D
2041                     <NOT <EMPTY? .D>>>
2042                 <PP-DBMS-TABLE .D> <CRLF>)
2043               (ELSE
2044                 <PRINC "DBMS table is empty"> <CRLF>)>>
2045 ;"\f"
2046 <DEFINE PP-ENTITY-PRED (TYP)
2047         #DECL ( (TYP)   PREDICATE-TYPES)
2048         <COND (<PT-ALL .TYP>
2049                 <PRINC "ALL ">)>
2050         <COND (<PT-NO .TYP>
2051                 <PRINC "NO ">)>
2052         <COND (<PT-QUANT .TYP>
2053                 <PRINC "QUANTIFIED ">)>
2054         <COND (<PT-NON-QUANT .TYP>
2055                 <PRINC "NON-QUANTIFIED ">)>
2056 >
2057 ;"\f"
2058 ;"PP-ENTITY-TYPE pretty prints an entry in the ENTITY-TYPE-TABLE."
2059
2060 <DEFINE PP-ENTITY-TYPE (E "AUX" (F <ET-FUNCTIONS .E>) M)
2061         #DECL ((E) ENTITY-TYPE (F) VECTOR (M) <OR E-PHY-REP FALSE>)
2062         <TPRINC "Entity type name: "> <PRINC <ET-NAME .E>> <CRLF>
2063         <TPRINC "ETID: "> <PRINC <ET-ETID .E>> <CRLF>
2064         <TPRINC "VID: "> <PRINC <ET-VID .E>> <CRLF>
2065         <TPRINC "Supertypes: ">
2066                 <PLIST <CHTYPE <ET-SUPERTYPES .E> LIST>>
2067                 <CRLF>
2068         <TPRINC "Subtypes: ">
2069                 <PLIST <CHTYPE <ET-SUBTYPES .E> LIST>>
2070                 <CRLF>
2071         <TPRINC "Cotypes: ">
2072                 <PLIST <CHTYPE <ET-COTYPES .E> LIST>>
2073                 <CRLF>
2074         <TPRINC "Map type: "> <PRINC <ET-MAP-TYPE .E>> <CRLF>
2075         <TPRINC "Map info: "> <CRLF>
2076         <SET M <ET-MAP-INFO .E>>
2077         <COND (<TYPE? .M E-PHY-REP>
2078                 <TTPRINC "Spelled: "> <PRIN1 <E-SPELLING .M>> <CRLF>
2079                 <TTPRINC "DBMS id: "> <PRINC <E-DBMS-ID .M>> <CRLF>
2080                 <TTPRINC "System entry point: "> <PRINC <E-SYS-EP .M>> <CRLF>
2081                 <COND (<E-SYS-EP-AP-ONLY .M>
2082                         <TTPRINC "System entry point by access path only">
2083                         <CRLF>)>
2084                 <TTPRINC "Context: "> <PRIN1 <E-CONTEXT .M>> <CRLF>
2085                 <TTPRINC "Owners: "> <PLIST <CHTYPE <E-OWNERS .M> LIST>> <CRLF>
2086                 <TTPRINC "# Fast access paths via equality: ">
2087                         <PRINC <E-AP-EQ-COUNT .M>> <CRLF>
2088                 <COND (<E-AREAS .M>
2089                         <TTPRINC "Areas: "> <PLIST <CHTYPE <E-AREAS .M> LIST>>
2090                         <CRLF>)>
2091                 <COND (<E-SYS-SET .M>
2092                         <TTPRINC "System owned set: "> <PRIN1 <E-SYS-SET .M>>
2093                         <CRLF>)>
2094                 <COND (<E-SYS-EP-KEYS .M>
2095                         <TTPRINC "Iterate using keys: ">
2096                         <PLIST <CHTYPE <E-SYS-EP-KEYS .M> LIST>>
2097                         <CRLF>)>
2098                 <COND (<E-ITER-PRED .M>
2099                         <TTPRINC "When domain of iteration, may use ">
2100                         <PP-ENTITY-PRED <E-ITER-PRED .M>>
2101                         <PRINC "predicates">
2102                         <CRLF>)>
2103                 <COND (<E-QUANT-PRED .M>
2104                         <TTPRINC "When domain of quantification, may use ">
2105                         <PP-ENTITY-PRED <E-QUANT-PRED .M>>
2106                         <PRINC "predicates">
2107                         <CRLF>)>
2108                 <COND (<E-NO-QUANT .M>
2109                         <TTPRINC "May not be domain of quantified expression">
2110                         <CRLF>)>
2111                 <COND (<E-KEY .M>
2112                         <COND (<EMPTY? <E-KEY .M>>
2113                                 <TTPRINC "Entity key is database_key.">)
2114                               (ELSE
2115                                 <TTPRINC "Entity key uses functions: ">
2116                                 <PLIST <CHTYPE <E-KEY .M> LIST>>)>)
2117                       (ELSE
2118                         <TTPRINC "Entity key is undefined.">)>
2119                 <CRLF>
2120                 )>
2121         <TPRINC "Functions:"> <CRLF> <PP-FUNC-TABLE .F>>
2122 ;"\f"
2123 ;"PP-ENTITY-TYPE-TABLE pretty prints the ENTITY-TYPE-TABLE."
2124
2125 <DEFINE PP-ENTITY-TYPE-TABLE (ET "AUX" (I 0))
2126         #DECL ((ET) VECTOR (I) FIX)
2127         <PRINC "Entity Type Table:"> <CRLF>
2128         <MAPF   <>
2129                 <FUNCTION (E)
2130                         <SET I <+ .I 1>>
2131                         <COND (.E
2132                                 <PRINC "  (">
2133                                 <PRINC .I>
2134                                 <PRINC ")">
2135                                 <PP-ENTITY-TYPE .E>)>>
2136                 .ET>>
2137 ;"\f"
2138 ;"PP-FUNC-TABLE pretty prints an entity type's functions."
2139
2140 <DEFINE PP-FUNC-TABLE (FT "AUX" (I 0) M)
2141         #DECL ((FT) VECTOR (I) FIX (M) <OR F-PHY-REP FALSE>)
2142         <MAPF   <>
2143                 <FUNCTION (F)
2144                         <SET I <+ .I 1>>
2145                         <COND (.F
2146                                 <TPRINC "(">
2147                                 <PRINC .I>
2148                                 <PRINC ")">
2149                                 <TPRINC "Name: "> <PRINC <F-NAME .F>> <CRLF>
2150                                 <TTPRINC "Type: "> <PRINC <F-TYPE .F>> <CRLF>
2151                                 <TTPRINC "Range: "> <PRINC <F-RANGE .F>> <CRLF>
2152                                 <TTPRINC "Min or ETID: ">
2153                                                 <PRINC <F-MIN .F>> <CRLF>
2154                                 <TTPRINC "Max: "> <PRINC <F-MAX .F>> <CRLF>
2155                                 <TTPRINC "Map type: "> <PRINC <F-MAP-TYPE .F>>
2156                                                 <CRLF>
2157                                 <TTPRINC "Map info:"> <CRLF>
2158                                 <SET M <F-MAP-INFO .F>>
2159                                 <COND (<TYPE? .M F-PHY-REP>
2160                                         <TTTPRINC "Spelled: ">
2161                                         <PRIN1 <F-SPELLING .M>> <CRLF>
2162                                         <COND (<OR <F-AP-EQ .M>
2163                                                    <F-AP-NQ .M>
2164                                                    <F-AP-RANGE .M>>
2165                                                 <TTTPRINC "Access path: ">
2166                                                 <COND (<F-AP-EQ .M>
2167                                                         <PRINC "EQ ">)>
2168                                                 <COND (<F-AP-NQ .M>
2169                                                         <PRINC "NQ ">)>
2170                                                 <COND (<F-AP-RANGE .M>
2171                                                         <PRINC "RANGE ">)>
2172                                                 <PRINC " when spelled ">
2173                                                 <PRIN1 <F-AP-SPELLING .M>>
2174                                                 <CRLF>
2175                                               )>
2176                                         <COND (<F-AP-UNIQUE .M>
2177                                                 <TTTPRINC "CALC keys are unique">
2178                                                 <CRLF>)>
2179                                         <COND (<F-AP-CO-FCNS .M>
2180                                                 <TTTPRINC "Access path co-functions: ">
2181                                                 <PLIST <CHTYPE <F-AP-CO-FCNS .M> LIST>>
2182                                                 <CRLF>)>
2183                                         <COND (<F-AP-SELECTS .M>
2184                                                 <TTTPRINC "Access path selects entity: ">
2185                                                 <PRINC <F-AP-SELECTS .M>>
2186                                                 <CRLF>)>
2187                                         <COND (<OR <==? <F-TYPE .F> F-INTEGER>
2188                                                    <==? <F-TYPE .F> F-STRING>>
2189                                                 <COND (<F-INT-STR .M>
2190                                                         <TTTPRINC "Stored as character string"> <CRLF>)>
2191                                                 <TTTPRINC "Characters to print: ">
2192                                                 <PRINC <F-CONV-CHARS .M>> <CRLF>)>
2193                                         <COND (<OR <==? <F-TYPE .F> F-STRING>
2194                                                    <F-INT-STR .M>>
2195                                                 <TTTPRINC "Min chars: ">
2196                                                 <PRINC <F-MIN-CHR .M>> <CRLF>
2197                                                 <TTTPRINC "Max chars: ">
2198                                                 <PRINC <F-MAX-CHR .M>> <CRLF>)>
2199                                         <COND (<OR <==? <F-TYPE .F> F-INTEGER>
2200                                                    <F-INT-STR .M>>
2201                                                 <TTTPRINC "Size in bits at GDM: ">
2202                                                 <PRINC <F-CONV-BITS .M>> <CRLF>)>
2203                                         <COND (<OR <F-SET .M>
2204                                                    <F-REPEAT-GRP .M>>
2205                                                 <COND (<F-SET .M>
2206                                                   <TTTPRINC "Implemented as: SET">
2207                                                   <CRLF>)>
2208                                                 <COND (<F-REPEAT-GRP .M>
2209                                                   <TTTPRINC "Implemented as: REPEATING GROUP">
2210                                                   <CRLF>)>)
2211                                               (ELSE
2212                                                 <COND (<NOT <==? <F-TYPE .F>
2213                                                                  F-ENTITY>>
2214                                                 <TTTPRINC "Size in bits at DBMS: ">
2215                                                 <PRINC <F-BITS .M>> <CRLF>
2216                                                 <TTTPRINC "Representation: ">
2217                                                 <PRINC <F-REP .M>> <CRLF>)>)>
2218                                         <COND (<SET AOP <F-ARITH-OPS .M>>
2219                                                 <TTTPRINC "Restricted to arithmetic operations: ">
2220                                                 <COND (<AOP-ALL .AOP>
2221                                                         <PRINC "ALL ">)>
2222                                                 <COND (<AOP-PLUS .AOP>
2223                                                         <PRINC "PLUS ">)>
2224                                                 <COND (<AOP-MINUS .AOP>
2225                                                         <PRINC "MINUS ">)>
2226                                                 <COND (<AOP-MULTIPLY .AOP>
2227                                                         <PRINC "MULTIPLY ">)>
2228                                                 <COND (<AOP-DIVIDE .AOP>
2229                                                         <PRINC "DIVIDE ">)>
2230                                                 <COND (<AOP-CONCAT .AOP>
2231                                                         <PRINC "CONCATENATE ">)>
2232                                                 <CRLF>)>
2233                                         <COND (<SET ROP <F-REL-OPS .M>>
2234                                                 <TTTPRINC "Restricted to relational operations: ">
2235                                                 <COND (<ROP-ALL .ROP>
2236                                                         <PRINC "ALL ">)>
2237                                                 <COND (<ROP-GT .ROP>
2238                                                         <PRINC "GT ">)>
2239                                                 <COND (<ROP-LT .ROP>
2240                                                         <PRINC "LT ">)>
2241                                                 <COND (<ROP-LE .ROP>
2242                                                         <PRINC "LE ">)>
2243                                                 <COND (<ROP-GE .ROP>
2244                                                         <PRINC "GE ">)>
2245                                                 <COND (<ROP-NE .ROP>
2246                                                         <PRINC "NE ">)>
2247                                                 <COND (<ROP-EQ .ROP>
2248                                                         <PRINC "EQ ">)>
2249                                                 <COND (<ROP-AC .ROP>
2250                                                         <PRINC "ALPHA-COLLATE ">)>
2251                                                 <COND (<ROP-ISIN .ROP>
2252                                                         <PRINC "ISIN ">)>
2253                                                 <CRLF>)>
2254                                 )>)>>
2255                 .FT>>
2256 ;"\f"
2257 ;"PP-VIEW-TABLE pretty prints the VIEW-TABLE."
2258
2259 <DEFINE PP-VIEW-TABLE (VT "AUX" (I 0))
2260         #DECL ((VT) VECTOR (I) FIX)
2261         <CRLF> <PRINC "View Table:"> <CRLF>
2262         <MAPF   <>
2263                 <FUNCTION (V)
2264                         <SET I <+ .I 1>>
2265                         <COND (.V
2266                                 <PRINC "  (">
2267                                 <PRINC .I>
2268                                 <PRINC ")">
2269                                 <TPRINC "View name: ">
2270                                 <PRINC <V-NAME .V>>
2271                                 <CRLF>)>>
2272                 .VT>>
2273
2274
2275 <ENDPACKAGE>    ;"BUILD-DIR"
2276
2277
2278 \0