1with STRINGS_PACKAGE; use STRINGS_PACKAGE; 2with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE; 3pragma ELABORATE(INFLECTIONS_PACKAGE); 4package body DICTIONARY_PACKAGE is 5 use STEM_KEY_TYPE_IO; 6 use TEXT_IO; 7 8 MNPC_IO_DEFAULT_WIDTH : constant NATURAL := 6; 9 NUMERAL_VALUE_TYPE_IO_DEFAULT_WIDTH : constant NATURAL := 5; 10 KIND_ENTRY_IO_DEFAULT_WIDTH : constant NATURAL := VERB_KIND_TYPE_IO.DEFAULT_WIDTH; 11 --PART_WIDTH : NATURAL; 12 13 14 function NUMBER_OF_STEMS(P : PART_OF_SPEECH_TYPE) return STEM_KEY_TYPE is 15 begin 16 case P is 17 when N => return 2; 18 when PRON => return 2; 19 when PACK => return 2; 20 when ADJ => return 4; 21 when NUM => return 4; 22 when ADV => return 3; 23 when V => return 4; 24 when VPAR => return 0; 25 when SUPINE => return 0; 26 when PREP => return 1; 27 when CONJ => return 1; 28 when INTERJ => return 1; 29 when others => return 0; 30 end case; 31 end NUMBER_OF_STEMS; 32 33 34 35 package body PARSE_RECORD_IO is 36 use TEXT_IO; 37 use INFLECTION_RECORD_IO; 38 use DICTIONARY_KIND_IO; 39 use MNPC_IO; 40 SPACER : CHARACTER := ' '; 41 42 procedure GET(F : in TEXT_IO.FILE_TYPE; PR: out PARSE_RECORD) is 43 begin 44 GET(F, PR.STEM); 45 GET(F, SPACER); 46 GET(F, PR.IR); 47 GET(F, SPACER); 48 GET(F, PR.D_K); 49 GET(F, SPACER); 50 GET(F, PR.MNPC); 51 end GET; 52 53 procedure GET(PR : out PARSE_RECORD) is 54 begin 55 GET(PR.STEM); 56 GET(SPACER); 57 GET(PR.IR); 58 GET(SPACER); 59 GET(PR.D_K); 60 GET(SPACER); 61 GET(PR.MNPC); 62 end GET; 63 64 procedure PUT(F : in TEXT_IO.FILE_TYPE; PR : in PARSE_RECORD) is 65 begin 66 PUT(F, PR.STEM); 67 PUT(F, ' '); 68 PUT(F, PR.IR); 69 PUT(F, ' '); 70 PUT(F, PR.D_K); 71 PUT(F, ' '); 72 PUT(F, PR.MNPC); 73 end PUT; 74 75 procedure PUT(PR : in PARSE_RECORD) is 76 begin 77 TEXT_IO.PUT(PR.STEM); 78 TEXT_IO.PUT(' '); 79 INFLECTION_RECORD_IO.PUT(PR.IR); 80 TEXT_IO.PUT(' '); 81 DICTIONARY_KIND_IO.PUT(PR.D_K); 82 TEXT_IO.PUT(' '); 83 MNPC_IO.PUT(PR.MNPC); 84 end PUT; 85 86 procedure GET(S : in STRING; PR : out PARSE_RECORD; LAST : out INTEGER) is 87 L : INTEGER := S'FIRST - 1; 88 begin 89 STEM_TYPE_IO.GET(S, PR.STEM, L); 90 L := L + 1; 91 GET(S(L+1..S'LAST), PR.IR, L); 92 L := L + 1; 93 GET(S(L+1..S'LAST), PR.D_K, L); 94 L := L + 1; 95 GET(S(L+1..S'LAST), PR.MNPC, LAST); 96 end GET; 97 98 procedure PUT(S : out STRING; PR : in PARSE_RECORD) is 99 L : INTEGER := 0; 100 M : INTEGER := 0; 101 begin 102 M := L + MAX_STEM_SIZE; 103 S(L+1..M) := PR.STEM; 104 L := M + 1; 105 S(L) := ' '; 106 M := L + INFLECTION_RECORD_IO.DEFAULT_WIDTH; 107 PUT(S(L+1..M), PR.IR); 108 L := M + 1; 109 S(L) := ' '; 110 M := L + DICTIONARY_KIND_IO.DEFAULT_WIDTH; 111 PUT(S(L+1..M), PR.D_K); 112 L := M + 1; 113 S(L) := ' '; 114 M := L + MNPC_IO_DEFAULT_WIDTH; 115 PUT(S(L+1..M), PR.MNPC); 116 S(M+1..S'LAST) := (others => ' '); 117 end PUT; 118 119 end PARSE_RECORD_IO; 120 121package body NOUN_ENTRY_IO is 122 use DECN_RECORD_IO; 123 use GENDER_TYPE_IO; 124 use NOUN_KIND_TYPE_IO; 125 SPACER : CHARACTER := ' '; 126 127 128 procedure GET(F : in FILE_TYPE; N : out NOUN_ENTRY) is 129 begin 130 GET(F, N.DECL); 131 GET(F, SPACER); 132 GET(F, N.GENDER); 133 GET(F, SPACER); 134 GET(F, N.KIND); 135 end GET; 136 137 procedure GET(N : out NOUN_ENTRY) is 138 begin 139 GET(N.DECL); 140 GET(SPACER); 141 GET(N.GENDER); 142 GET(SPACER); 143 GET(N.KIND); 144 end GET; 145 146 procedure PUT(F : in FILE_TYPE; N : in NOUN_ENTRY) is 147 begin 148 PUT(F, N.DECL); 149 PUT(F, ' '); 150 PUT(F, N.GENDER); 151 PUT(F, ' '); 152 PUT(F, N.KIND); 153 end PUT; 154 155 procedure PUT(N : in NOUN_ENTRY) is 156 begin 157 PUT(N.DECL); 158 PUT(' '); 159 PUT(N.GENDER); 160 PUT(' '); 161 PUT(N.KIND); 162 end PUT; 163 164 procedure GET(S : in STRING; N : out NOUN_ENTRY; LAST : out INTEGER) is 165 L : INTEGER := S'FIRST - 1; 166 begin 167 GET(S(L+1..S'LAST), N.DECL, L); 168 L := L + 1; 169 GET(S(L+1..S'LAST), N.GENDER, L); 170 L := L + 1; 171 GET(S(L+1..S'LAST), N.KIND, LAST); 172 end GET; 173 174 procedure PUT(S : out STRING; N : in NOUN_ENTRY) is 175 L : INTEGER := S'FIRST - 1; 176 M : INTEGER := 0; 177 begin 178 M := L + DECN_RECORD_IO.DEFAULT_WIDTH; 179 PUT(S(L+1..M), N.DECL); 180 L := M + 1; 181 S(L) := ' '; 182 M := L + GENDER_TYPE_IO.DEFAULT_WIDTH; 183 PUT(S(L+1..M), N.GENDER); 184 L := M + 1; 185 S(L) := ' '; 186 M := L + NOUN_KIND_TYPE_IO.DEFAULT_WIDTH; 187 PUT(S(L+1..M), N.KIND); 188 S(M+1..S'LAST) := (others => ' '); 189 end PUT; 190 191 192end NOUN_ENTRY_IO; 193 194 195package body PRONOUN_ENTRY_IO is 196 use DECN_RECORD_IO; 197 use PRONOUN_KIND_TYPE_IO; 198 SPACER : CHARACTER := ' '; 199 200 201 procedure GET(F : in FILE_TYPE; P : out PRONOUN_ENTRY) is 202 begin 203 GET(F, P.DECL); 204 GET(F, SPACER); 205 GET(F, P.KIND); 206 end GET; 207 208 procedure GET(P : out PRONOUN_ENTRY) is 209 begin 210 GET(P.DECL); 211 GET(SPACER); 212 GET(P.KIND); 213 end GET; 214 215 procedure PUT(F : in FILE_TYPE; P : in PRONOUN_ENTRY) is 216 begin 217 PUT(F, P.DECL); 218 PUT(F, ' '); 219 PUT(F, P.KIND); 220 end PUT; 221 222 procedure PUT(P : in PRONOUN_ENTRY) is 223 begin 224 PUT(P.DECL); 225 PUT(' '); 226 PUT(P.KIND); 227 end PUT; 228 229 procedure GET(S : in STRING; P : out PRONOUN_ENTRY; LAST : out INTEGER) is 230 L : INTEGER := S'FIRST - 1; 231 begin 232 GET(S(L+1..S'LAST), P.DECL, L); 233 L := L + 1; 234 GET(S(L+1..S'LAST), P.KIND, LAST); 235 end GET; 236 237 procedure PUT(S : out STRING; P : in PRONOUN_ENTRY) is 238 L : INTEGER := S'FIRST - 1; 239 M : INTEGER := 0; 240 begin 241 M := L + DECN_RECORD_IO.DEFAULT_WIDTH; 242 PUT(S(L+1..M), P.DECL); 243 L := M + 1; 244 S(L) := ' '; 245 M := L + PRONOUN_KIND_TYPE_IO.DEFAULT_WIDTH; 246 PUT(S(L+1..M), P.KIND); 247 S(M+1..S'LAST) := (others => ' '); 248 end PUT; 249 250 251end PRONOUN_ENTRY_IO; 252 253 254package body PROPACK_ENTRY_IO is 255 use DECN_RECORD_IO; 256 use PRONOUN_KIND_TYPE_IO; 257 SPACER : CHARACTER := ' '; 258 259 260 procedure GET(F : in FILE_TYPE; P : out PROPACK_ENTRY) is 261 begin 262 GET(F, P.DECL); 263 GET(F, SPACER); 264 GET(F, P.KIND); 265 end GET; 266 267 procedure GET(P : out PROPACK_ENTRY) is 268 begin 269 GET(P.DECL); 270 GET(SPACER); 271 GET(P.KIND); 272 end GET; 273 274 procedure PUT(F : in FILE_TYPE; P : in PROPACK_ENTRY) is 275 begin 276 PUT(F, P.DECL); 277 PUT(F, ' '); 278 PUT(F, P.KIND); 279 end PUT; 280 281 procedure PUT(P : in PROPACK_ENTRY) is 282 begin 283 PUT(P.DECL); 284 PUT(' '); 285 PUT(P.KIND); 286 end PUT; 287 288 procedure GET(S : in STRING; P : out PROPACK_ENTRY; LAST : out INTEGER) is 289 L : INTEGER := S'FIRST - 1; 290 begin 291 GET(S(L+1..S'LAST), P.DECL, L); 292 L := L + 1; 293 GET(S(L+1..S'LAST), P.KIND, LAST); 294 end GET; 295 296 procedure PUT(S : out STRING; P : in PROPACK_ENTRY) is 297 L : INTEGER := S'FIRST - 1; 298 M : INTEGER := 0; 299 begin 300 M := L + DECN_RECORD_IO.DEFAULT_WIDTH; 301 PUT(S(L+1..M), P.DECL); 302 L := M + 1; 303 S(L) := ' '; 304 M := L + PRONOUN_KIND_TYPE_IO.DEFAULT_WIDTH; 305 PUT(S(L+1..M), P.KIND); 306 S(M+1..S'LAST) := (others => ' '); 307 end PUT; 308 309 310end PROPACK_ENTRY_IO; 311 312 313package body ADJECTIVE_ENTRY_IO is 314 use DECN_RECORD_IO; 315 use GENDER_TYPE_IO; 316 use CASE_TYPE_IO; 317 use NUMBER_TYPE_IO; 318 use COMPARISON_TYPE_IO; 319 SPACER : CHARACTER := ' '; 320 321 322 procedure GET(F : in FILE_TYPE; A : out ADJECTIVE_ENTRY) is 323 begin 324 GET(F, A.DECL); 325 GET(F, SPACER); 326 GET(F, A.CO); 327 end GET; 328 329 procedure GET(A : out ADJECTIVE_ENTRY) is 330 begin 331 GET(A.DECL); 332 GET(SPACER); 333 GET(A.CO); 334 end GET; 335 336 procedure PUT(F : in FILE_TYPE; A : in ADJECTIVE_ENTRY) is 337 begin 338 PUT(F, A.DECL); 339 PUT(F, ' '); 340 PUT(F, A.CO); 341 end PUT; 342 343 procedure PUT(A : in ADJECTIVE_ENTRY) is 344 begin 345 PUT(A.DECL); 346 PUT(' '); 347 PUT(A.CO); 348 end PUT; 349 350 procedure GET(S : in STRING; A : out ADJECTIVE_ENTRY; LAST : out INTEGER) is 351 L : INTEGER := S'FIRST - 1; 352 begin 353 GET(S(L+1..S'LAST), A.DECL, L); 354 L := L + 1; 355 GET(S(L+1..S'LAST), A.CO, LAST); 356 end GET; 357 358 procedure PUT(S : out STRING; A : in ADJECTIVE_ENTRY) is 359 L : INTEGER := S'FIRST - 1; 360 M : INTEGER := 0; 361 begin 362 M := L + DECN_RECORD_IO.DEFAULT_WIDTH; 363 PUT(S(L+1..M), A.DECL); 364 L := M + 1; 365 S(L) := ' '; 366 M := L + COMPARISON_TYPE_IO.DEFAULT_WIDTH; 367 PUT(S(L+1..M), A.CO); 368 S(M+1..S'LAST) := (others => ' '); 369 end PUT; 370 371 372end ADJECTIVE_ENTRY_IO; 373 374 375 376package body NUMERAL_ENTRY_IO is 377 use DECN_RECORD_IO; 378 use NUMERAL_SORT_TYPE_IO; 379 use INFLECTIONS_PACKAGE.INTEGER_IO; 380 SPACER : CHARACTER := ' '; 381 382 NUM_OUT_SIZE : constant := 5; -- Set in spec !!!!!!!!!!!!!!!!!!!!!!!!! 383 384 385 procedure GET(F : in FILE_TYPE; NUM : out NUMERAL_ENTRY) is 386 begin 387 GET(F, NUM.DECL); 388 GET(F, SPACER); 389 GET(F, NUM.SORT); 390 GET(F, SPACER); 391 GET(F, NUM.VALUE); 392 end GET; 393 394 procedure GET(NUM : out NUMERAL_ENTRY) is 395 begin 396 GET(NUM.DECL); 397 GET(SPACER); 398 GET(NUM.SORT); 399 GET(SPACER); 400 GET(NUM.VALUE); 401 end GET; 402 403 procedure PUT(F : in FILE_TYPE; NUM : in NUMERAL_ENTRY) is 404 begin 405 PUT(F, NUM.DECL); 406 PUT(F, ' '); 407 PUT(F, NUM.SORT); 408 PUT(F, ' '); 409 PUT(F, NUM.VALUE, NUM_OUT_SIZE); 410 end PUT; 411 412 procedure PUT(NUM : in NUMERAL_ENTRY) is 413 begin 414 PUT(NUM.DECL); 415 PUT(' '); 416 PUT(NUM.SORT); 417 PUT(' '); 418 PUT(NUM.VALUE, NUM_OUT_SIZE); 419 end PUT; 420 421 procedure GET(S : in STRING; NUM : out NUMERAL_ENTRY; LAST : out INTEGER) is 422 L : INTEGER := S'FIRST - 1; 423 begin 424--TEXT_IO.PUT("+1"); 425 GET(S(L+1..S'LAST), NUM.DECL, L); 426--TEXT_IO.PUT("+2"); 427 L := L + 1; 428 GET(S(L+1..S'LAST), NUM.SORT, L); 429--TEXT_IO.PUT("+3"); 430 L := L + 1; 431 GET(S(L+1..S'LAST), NUM.VALUE, LAST); 432--TEXT_IO.PUT("+4"); 433 end GET; 434 435 procedure PUT(S : out STRING; NUM : in NUMERAL_ENTRY) is 436 L : INTEGER := S'FIRST - 1; 437 M : INTEGER := 0; 438 begin 439 M := L + DECN_RECORD_IO.DEFAULT_WIDTH; 440 PUT(S(L+1..M), NUM.DECL); 441 L := M + 1; 442 S(L) := ' '; 443 M := L + NUMERAL_SORT_TYPE_IO.DEFAULT_WIDTH; 444 PUT(S(L+1..M), NUM.SORT); 445 L := M + 1; 446 S(L) := ' '; 447 --M := L + NUMERAL_VALUE_TYPE_IO.DEFAULT_WIDTH; 448 M := L + NUM_OUT_SIZE; 449 PUT(S(L+1..M), NUM.VALUE); 450 S(M+1..S'LAST) := (others => ' '); 451 end PUT; 452 453 454end NUMERAL_ENTRY_IO; 455 456 457package body ADVERB_ENTRY_IO is 458 use COMPARISON_TYPE_IO; 459 SPACER : CHARACTER := ' '; 460 461 462 procedure GET(F : in FILE_TYPE; A : out ADVERB_ENTRY) is 463 begin 464 GET(F, A.CO); 465 end GET; 466 467 procedure GET(A : out ADVERB_ENTRY) is 468 begin 469 GET(A.CO); 470 end GET; 471 472 procedure PUT(F : in FILE_TYPE; A : in ADVERB_ENTRY) is 473 begin 474 PUT(F, A.CO); 475 end PUT; 476 477 procedure PUT(A : in ADVERB_ENTRY) is 478 begin 479 PUT(A.CO); 480 end PUT; 481 482 procedure GET(S : in STRING; A : out ADVERB_ENTRY; LAST : out INTEGER) is 483 L : INTEGER := S'FIRST - 1; 484 begin 485 GET(S(L+1..S'LAST), A.CO, LAST); 486 end GET; 487 488 procedure PUT(S : out STRING; A : in ADVERB_ENTRY) is 489 L : INTEGER := S'FIRST - 1; 490 M : INTEGER := 0; 491 begin 492 M := L + COMPARISON_TYPE_IO.DEFAULT_WIDTH; 493 PUT(S(L+1..M), A.CO); 494 S(M+1..S'LAST) := (others => ' '); 495 end PUT; 496 497 498end ADVERB_ENTRY_IO; 499 500 501package body VERB_ENTRY_IO is 502 use DECN_RECORD_IO; 503 use VERB_KIND_TYPE_IO; 504 SPACER : CHARACTER := ' '; 505 506 507 procedure GET(F : in FILE_TYPE; V : out VERB_ENTRY) is 508 begin 509 GET(F, V.CON); 510 GET(F, SPACER); 511 GET(F, V.KIND); 512 end GET; 513 514 procedure GET(V : out VERB_ENTRY) is 515 begin 516 GET(V.CON); 517 GET(SPACER); 518 GET(V.KIND); 519 end GET; 520 521 procedure PUT(F : in FILE_TYPE; V : in VERB_ENTRY) is 522 begin 523 PUT(F, V.CON); 524 PUT(F, ' '); 525 PUT(F, V.KIND); 526 end PUT; 527 528 procedure PUT(V : in VERB_ENTRY) is 529 begin 530 PUT(V.CON); 531 PUT(' '); 532 PUT(V.KIND); 533 end PUT; 534 535 procedure GET(S : in STRING; V : out VERB_ENTRY; LAST : out INTEGER) is 536 L : INTEGER := S'FIRST - 1; 537 begin 538 GET(S(L+1..S'LAST), V.CON, L); 539 L := L + 1; 540 GET(S(L+1..S'LAST), V.KIND, LAST); 541 end GET; 542 543 procedure PUT(S : out STRING; V : in VERB_ENTRY) is 544 L : INTEGER := S'FIRST - 1; 545 M : INTEGER := 0; 546 begin 547 M := L + DECN_RECORD_IO.DEFAULT_WIDTH; 548 PUT(S(L+1..M), V.CON); 549 L := M + 1; 550 S(L) := ' '; 551 M := L + VERB_KIND_TYPE_IO.DEFAULT_WIDTH; 552 PUT(S(L+1..M), V.KIND); 553 S(M+1..S'LAST) := (others => ' '); 554 end PUT; 555 556 557end VERB_ENTRY_IO; 558 559 560package body PREPOSITION_ENTRY_IO is 561 use CASE_TYPE_IO; 562 SPACER : CHARACTER := ' '; 563 564 procedure GET(F : in FILE_TYPE; P : out PREPOSITION_ENTRY) is 565 begin 566 GET(F, P.OBJ); 567 end GET; 568 569 procedure GET(P : out PREPOSITION_ENTRY) is 570 begin 571 GET(P.OBJ); 572 end GET; 573 574 procedure PUT(F : in FILE_TYPE; P : in PREPOSITION_ENTRY) is 575 begin 576 PUT(F, P.OBJ); 577 end PUT; 578 579 procedure PUT(P : in PREPOSITION_ENTRY) is 580 begin 581 PUT(P.OBJ); 582 end PUT; 583 584 procedure GET(S : in STRING; P : out PREPOSITION_ENTRY; LAST : out INTEGER) is 585 begin 586 GET(S, P.OBJ, LAST); 587 end GET; 588 589 procedure PUT(S : out STRING; P : in PREPOSITION_ENTRY) is 590 L : INTEGER := S'FIRST - 1; 591 M : INTEGER := 0; 592 begin 593 M := L + CASE_TYPE_IO.DEFAULT_WIDTH; 594 PUT(S(L+1..M), P.OBJ); 595 S(M+1..S'LAST) := (others => ' '); 596 end PUT; 597 598 599end PREPOSITION_ENTRY_IO; 600 601 602package body CONJUNCTION_ENTRY_IO is 603 NULL_CONJUNCTION_ENTRY : CONJUNCTION_ENTRY; 604 SPACER : CHARACTER := ' '; 605 606 607 procedure GET(F : in FILE_TYPE; C : out CONJUNCTION_ENTRY) is 608 begin 609 C := NULL_CONJUNCTION_ENTRY; 610 end GET; 611 612 procedure GET(C : out CONJUNCTION_ENTRY) is 613 begin 614 C := NULL_CONJUNCTION_ENTRY; 615 end GET; 616 617 procedure PUT(F : in FILE_TYPE; C : in CONJUNCTION_ENTRY) is 618 begin 619 null; 620 end PUT; 621 622 procedure PUT(C : in CONJUNCTION_ENTRY) is 623 begin 624 null; 625 end PUT; 626 627 procedure GET(S : in STRING; C : out CONJUNCTION_ENTRY; LAST : out INTEGER) is 628 L : INTEGER := S'FIRST - 1; 629 begin 630 C := NULL_CONJUNCTION_ENTRY; 631 LAST := L; 632 end GET; 633 634 procedure PUT(S : out STRING; C : in CONJUNCTION_ENTRY) is 635 begin 636 S(S'FIRST..S'LAST) := (others => ' '); 637 end PUT; 638 639 640end CONJUNCTION_ENTRY_IO; 641 642 643package body INTERJECTION_ENTRY_IO is 644 NULL_INTERJECTION_ENTRY : INTERJECTION_ENTRY; 645 SPACER : CHARACTER := ' '; 646 647 procedure GET(F : in FILE_TYPE; I : out INTERJECTION_ENTRY) is 648 begin 649 I := NULL_INTERJECTION_ENTRY; 650 end GET; 651 652 procedure GET(I : out INTERJECTION_ENTRY) is 653 begin 654 I := NULL_INTERJECTION_ENTRY; 655 end GET; 656 657 procedure PUT(F : in FILE_TYPE; I : in INTERJECTION_ENTRY) is 658 begin 659 null; 660 end PUT; 661 662 procedure PUT(I : in INTERJECTION_ENTRY) is 663 begin 664 null; 665 end PUT; 666 667 procedure GET(S : in STRING; I : out INTERJECTION_ENTRY; LAST : out INTEGER) is 668 L : INTEGER := S'FIRST - 1; 669 begin 670 I := NULL_INTERJECTION_ENTRY; 671 LAST := L; 672 end GET; 673 674 procedure PUT(S : out STRING; I : in INTERJECTION_ENTRY) is 675 begin 676 S(S'FIRST..S'LAST) := (others => ' '); 677 end PUT; 678 679 680end INTERJECTION_ENTRY_IO; 681 682 683 684function "<" (LEFT, RIGHT : PART_ENTRY) return BOOLEAN is 685 begin 686 if LEFT.POFS = RIGHT.POFS then 687 case LEFT.POFS is 688 when N => 689 if LEFT.N.DECL < RIGHT.N.DECL or else 690 (LEFT.N.DECL = RIGHT.N.DECL and then 691 LEFT.N.GENDER < RIGHT.N.GENDER) or else 692 ((LEFT.N.DECL = RIGHT.N.DECL and 693 LEFT.N.GENDER = RIGHT.N.GENDER) and then 694 LEFT.N.KIND < RIGHT.N.KIND) then 695 return TRUE; 696 end if; 697 when PRON => 698 if LEFT.PRON.DECL < RIGHT.PRON.DECL or else 699 (LEFT.PRON.DECL = RIGHT.PRON.DECL and then 700 LEFT.PRON.KIND < RIGHT.PRON.KIND) then 701 return TRUE; 702 end if; 703 when PACK => 704 if LEFT.PACK.DECL < RIGHT.PACK.DECL or else 705 (LEFT.PACK.DECL = RIGHT.PACK.DECL and then 706 LEFT.PACK.KIND < RIGHT.PACK.KIND) then 707 return TRUE; 708 end if; 709 when ADJ => 710 if LEFT.ADJ.DECL < RIGHT.ADJ.DECL or else 711 (LEFT.ADJ.DECL = RIGHT.ADJ.DECL and then 712 LEFT.ADJ.CO < RIGHT.ADJ.CO) then 713 return TRUE; 714 end if; 715 when NUM => 716 if LEFT.NUM.DECL < RIGHT.NUM.DECL or else 717 (LEFT.NUM.DECL = RIGHT.NUM.DECL and then 718 LEFT.NUM.SORT < RIGHT.NUM.SORT) or else 719 ((LEFT.NUM.DECL = RIGHT.NUM.DECL) and then 720 (LEFT.NUM.SORT = RIGHT.NUM.SORT) and then 721 LEFT.NUM.VALUE < RIGHT.NUM.VALUE) then 722 return TRUE; 723 end if;when ADV => 724 return LEFT.ADV.CO < RIGHT.ADV.CO; 725 when V => 726 if (LEFT.V.CON < RIGHT.V.CON) or else 727 (LEFT.V.CON = RIGHT.V.CON and then 728 LEFT.V.KIND < RIGHT.V.KIND) then 729 return TRUE; 730 end if; 731 when PREP => 732 return LEFT.PREP.OBJ < RIGHT.PREP.OBJ; 733 when others => 734 null; 735 end case; 736 else 737 return LEFT.POFS < RIGHT.POFS; 738 end if; 739 return FALSE; 740 exception 741 when CONSTRAINT_ERROR => 742 return LEFT.POFS < RIGHT.POFS; 743 end "<"; 744 745 746 747package body PART_ENTRY_IO is 748 use PART_OF_SPEECH_TYPE_IO; 749 use NOUN_ENTRY_IO; 750 use PRONOUN_ENTRY_IO; 751 use PROPACK_ENTRY_IO; 752 use ADJECTIVE_ENTRY_IO; 753 use NUMERAL_ENTRY_IO; 754 use ADVERB_ENTRY_IO; 755 use VERB_ENTRY_IO; 756 use PREPOSITION_ENTRY_IO; 757 use CONJUNCTION_ENTRY_IO; 758 use INTERJECTION_ENTRY_IO; 759 SPACER : CHARACTER := ' '; 760 761 762 NOUN : NOUN_ENTRY; 763 PRONOUN : PRONOUN_ENTRY; 764 PROPACK : PROPACK_ENTRY; 765 ADJECTIVE : ADJECTIVE_ENTRY; 766 NUMERAL : NUMERAL_ENTRY; 767 ADVERB : ADVERB_ENTRY; 768 VERB : VERB_ENTRY; 769 PREPOSITION : PREPOSITION_ENTRY; 770 CONJUNCTION : CONJUNCTION_ENTRY; 771 INTERJECTION : INTERJECTION_ENTRY; 772 773 PR : PART_ENTRY; 774 775 776 procedure GET(F : in FILE_TYPE; P : out PART_ENTRY) is 777 PS : PART_OF_SPEECH_TYPE := X; 778 C : POSITIVE_COUNT := COL(F); 779 begin 780 GET(F, PS); 781 GET(F, SPACER); 782 case PS is 783 when N => 784 GET(F, NOUN); 785 P := (N, NOUN); 786 when PRON => 787 GET(F, PRONOUN); 788 P := (PRON, PRONOUN); 789 when PACK => 790 GET(F, PROPACK); 791 P := (PACK, PROPACK); 792 when ADJ => 793 GET(F, ADJECTIVE); 794 P := (ADJ, ADJECTIVE); 795 when NUM => 796 GET(F, NUMERAL); 797 P := (NUM, NUMERAL); 798 when ADV => 799 GET(F, ADVERB); 800 P := (ADV, ADVERB); 801 when V => 802 GET(F, VERB); 803 P := (V, VERB); 804 when VPAR => 805 null; -- No VAPR entry 806 when SUPINE => 807 null; -- No SUPINE entry 808 when PREP => 809 GET(F, PREPOSITION); 810 P := (PREP, PREPOSITION); 811 when CONJ => 812 GET(F, CONJUNCTION); 813 P := (CONJ, CONJUNCTION); 814 when INTERJ => 815 GET(F, INTERJECTION); 816 P := (INTERJ, INTERJECTION); 817 when PREFIX => 818 P := (POFS => PREFIX); 819 when SUFFIX => 820 P := (POFS => SUFFIX); 821 when TACKON => 822 P := (POFS => TACKON); 823 when X => 824 P := (POFS => X); 825 end case; 826 SET_COL(F, POSITIVE_COUNT(PART_ENTRY_IO.DEFAULT_WIDTH)+C); 827 return; 828 end GET; 829 830 procedure GET(P : out PART_ENTRY) is 831 PS : PART_OF_SPEECH_TYPE := X; 832 begin 833 GET(PS); 834 GET(SPACER); 835 case PS is 836 when N => 837 GET(NOUN); 838 P := (N, NOUN); 839 when PRON => 840 GET(PRONOUN); 841 P := (PRON, PRONOUN); 842 when PACK => 843 GET(PROPACK); 844 P := (PACK, PROPACK); 845 when ADJ => 846 GET(ADJECTIVE); 847 P := (ADJ, ADJECTIVE); 848 when NUM => 849 GET(NUMERAL); 850 P := (NUM, NUMERAL); 851 when ADV => 852 GET(ADVERB); 853 P := (ADV, ADVERB); 854 when V => 855 GET(VERB); 856 P := (V, VERB); 857 when VPAR => 858 null; -- No VAPR entry 859 when SUPINE => 860 null; -- No SUPINE entry 861 when PREP => 862 GET(PREPOSITION); 863 P := (PREP, PREPOSITION); 864 when CONJ => 865 GET(CONJUNCTION); 866 P := (CONJ, CONJUNCTION); 867 when INTERJ => 868 GET(INTERJECTION); 869 P := (INTERJ, INTERJECTION); 870 when PREFIX => 871 P := (POFS => PREFIX); 872 when SUFFIX => 873 P := (POFS => SUFFIX); 874 when TACKON => 875 P := (POFS => TACKON); 876 when X => 877 P := (POFS => X); 878 end case; 879 return; 880 end GET; 881 882 procedure PUT(F : in FILE_TYPE; P : in PART_ENTRY) is 883 C : POSITIVE := POSITIVE(COL(F)); 884 begin 885 PUT(F, P.POFS); 886 PUT(F, ' '); 887 case P.POFS is 888 when N => 889 PUT(F, P.N); 890 when PRON => 891 PUT(F, P.PRON); 892 when PACK => 893 PUT(F, P.PACK); 894 when ADJ => 895 PUT(F, P.ADJ); 896 when NUM => 897 PUT(F, P.NUM); 898 when ADV => 899 PUT(F, P.ADV); 900 when V => 901 PUT(F, P.V); 902 when VPAR => 903 null; -- No VAPR entry 904 when SUPINE => 905 null; -- No SUPINE entry 906 when PREP => 907 PUT(F, P.PREP); 908 when CONJ => 909 PUT(F, P.CONJ); 910 when INTERJ => 911 PUT(F, P.INTERJ); 912 when others => 913 null; 914 end case; 915 --PUT(F, STRING'((INTEGER(COL(F))..PART_ENTRY_IO.DEFAULT_WIDTH+C-1 => ' '))); 916 return; 917 end PUT; 918 919 920 procedure PUT(P : in PART_ENTRY) is 921 C : POSITIVE := POSITIVE(COL); 922 begin 923 PUT(P.POFS); 924 PUT(' '); 925 case P.POFS is 926 when N => 927 PUT(P.N); 928 when PRON => 929 PUT(P.PRON); 930 when PACK => 931 PUT(P.PACK); 932 when ADJ => 933 PUT(P.ADJ); 934 when NUM => 935 PUT(P.NUM); 936 when ADV => 937 PUT(P.ADV); 938 when V => 939 PUT(P.V); 940 when VPAR => 941 null; -- No VAPR entry 942 when SUPINE => 943 null; -- No SUPINE entry 944 when PREP => 945 PUT(P.PREP); 946 when CONJ => 947 PUT(P.CONJ); 948 when INTERJ => 949 PUT(P.INTERJ); 950 when others => 951 null; 952 end case; 953 --PUT(STRING'((INTEGER(COL)..PART_ENTRY_IO.DEFAULT_WIDTH+C-1 => ' '))); 954 return; 955 end PUT; 956 957 procedure GET(S : in STRING; P : out PART_ENTRY; LAST : out INTEGER) is 958 L : INTEGER := S'FIRST - 1; 959 PS : PART_OF_SPEECH_TYPE := X; 960 begin 961 LAST := L; -- In case it is not set later 962 GET(S, PS, L); 963 L := L + 1; 964 case PS is 965 when N => 966 GET(S(L+1..S'LAST), NOUN, LAST); 967 P := (N, NOUN); 968 when PRON => 969 GET(S(L+1..S'LAST), PRONOUN, LAST); 970 P := (PRON, PRONOUN); 971 when PACK => 972 GET(S(L+1..S'LAST), PROPACK, LAST); 973 P := (PACK, PROPACK); 974 when ADJ => 975 GET(S(L+1..S'LAST), ADJECTIVE, LAST); 976 P := (ADJ, ADJECTIVE); 977 when NUM => 978 GET(S(L+1..S'LAST), NUMERAL, LAST); 979 P := (NUM, NUMERAL); 980 when ADV => 981 GET(S(L+1..S'LAST), ADVERB, LAST); 982 P := (ADV, ADVERB); 983 when V => 984 GET(S(L+1..S'LAST), VERB, LAST); 985 P := (V, VERB); 986 when VPAR => 987 null; -- No VAPR entry 988 when SUPINE => 989 null; -- No SUPINE entry 990 when PREP => 991 GET(S(L+1..S'LAST), PREPOSITION, LAST); 992 P := (PREP, PREPOSITION); 993 when CONJ => 994 GET(S(L+1..S'LAST), CONJUNCTION, LAST); 995 P := (CONJ, CONJUNCTION); 996 when INTERJ => 997 GET(S(L+1..S'LAST), INTERJECTION, LAST); 998 P := (INTERJ, INTERJECTION); 999 when PREFIX => 1000 P := (POFS => PREFIX); 1001 when SUFFIX => 1002 P := (POFS => SUFFIX); 1003 when TACKON => 1004 P := (POFS => TACKON); 1005 when X => 1006 P := (POFS => X); 1007 end case; 1008 end GET; 1009 1010 1011 procedure PUT(S : out STRING; P : in PART_ENTRY) is 1012 L : INTEGER := S'FIRST - 1; 1013 M : INTEGER := 0; 1014 begin 1015 M := L + PART_OF_SPEECH_TYPE_IO.DEFAULT_WIDTH; 1016 PUT(S(L+1..M), P.POFS); 1017 L := M + 1; 1018 S(L) := ' '; 1019 case P.POFS is 1020 when N => 1021 M := L + NOUN_ENTRY_IO.DEFAULT_WIDTH; 1022 PUT(S(L+1..M), P.N); 1023 when PRON => 1024 M := L + PRONOUN_ENTRY_IO.DEFAULT_WIDTH; 1025 PUT(S(L+1..M), P.PRON); 1026 when PACK => 1027 M := L + PROPACK_ENTRY_IO.DEFAULT_WIDTH; 1028 PUT(S(L+1..M), P.PACK); 1029 when ADJ => 1030 M := L + ADJECTIVE_ENTRY_IO.DEFAULT_WIDTH; 1031 PUT(S(L+1..M), P.ADJ); 1032 when NUM => 1033 M := L + NUMERAL_ENTRY_IO.DEFAULT_WIDTH; 1034 PUT(S(L+1..M), P.NUM); 1035 when ADV => 1036 M := L + ADVERB_ENTRY_IO.DEFAULT_WIDTH; 1037 PUT(S(L+1..M), P.ADV); 1038 when V => 1039 M := L + VERB_ENTRY_IO.DEFAULT_WIDTH; 1040 PUT(S(L+1..M), P.V); 1041 when VPAR => 1042 null; -- No VAPR entryR 1043 when SUPINE => 1044 null; -- No SUPINE entry 1045 when PREP => 1046 M := L + PREPOSITION_ENTRY_IO.DEFAULT_WIDTH; 1047 PUT(S(L+1..M), P.PREP); 1048 when CONJ => 1049 M := L + CONJUNCTION_ENTRY_IO.DEFAULT_WIDTH; 1050 PUT(S(L+1..M), P.CONJ); 1051 when INTERJ => 1052 M := L + INTERJECTION_ENTRY_IO.DEFAULT_WIDTH; 1053 PUT(S(L+1..M), P.INTERJ); 1054 when others => 1055 null; 1056 end case; 1057 --S(M+1..S'LAST) := (others => ' '); 1058 end PUT; 1059 1060 1061end PART_ENTRY_IO; 1062 1063 1064 1065 1066package body KIND_ENTRY_IO is 1067 use NOUN_KIND_TYPE_IO; 1068 use PRONOUN_KIND_TYPE_IO; 1069 use INFLECTIONS_PACKAGE.INTEGER_IO; 1070 use VERB_KIND_TYPE_IO; 1071 SPACER : CHARACTER := ' '; 1072 1073 1074 NOUN_KIND : NOUN_KIND_TYPE; 1075 PRONOUN_KIND : PRONOUN_KIND_TYPE; 1076 PROPACK_KIND : PRONOUN_KIND_TYPE; 1077 VERB_KIND : VERB_KIND_TYPE; 1078 VPAR_KIND : VERB_KIND_TYPE; 1079 SUPINE_KIND : VERB_KIND_TYPE; 1080 NUMERAL_VALUE : NUMERAL_VALUE_TYPE; 1081 1082 1083 1084 procedure GET(F : in FILE_TYPE; 1085 PS : in PART_OF_SPEECH_TYPE; P : out KIND_ENTRY) is 1086 begin 1087 case PS is 1088 when N => 1089 GET(F, NOUN_KIND); 1090 P := (N, NOUN_KIND); 1091 when PRON => 1092 GET(F, PRONOUN_KIND); 1093 P := (PRON, PRONOUN_KIND); 1094 when PACK => 1095 GET(F, PROPACK_KIND); 1096 P := (PACK, PROPACK_KIND); 1097 when ADJ => 1098 SET_COL(F, COL(F) + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH)); 1099 P := (POFS => ADJ); 1100 when NUM => 1101 GET(F, NUMERAL_VALUE); 1102 P := (NUM, NUMERAL_VALUE); 1103 when ADV => 1104 SET_COL(F, COL(F) + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH)); 1105 P := (POFS => ADV); 1106 when V => 1107 GET(F, VERB_KIND); 1108 P := (V, VERB_KIND); 1109 when VPAR => 1110 GET(F, VPAR_KIND); 1111 P := (VPAR, VPAR_KIND); 1112 when SUPINE => 1113 GET(F, SUPINE_KIND); 1114 P := (SUPINE, SUPINE_KIND); 1115 when PREP => 1116 SET_COL(F, COL(F) + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH)); 1117 P := (POFS => PREP); 1118 when CONJ => 1119 SET_COL(F, COL(F) + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH)); 1120 P := (POFS => CONJ); 1121 when INTERJ => 1122 SET_COL(F, COL(F) + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH)); 1123 P := (POFS => INTERJ); 1124 when TACKON => 1125 SET_COL(F, COL(F) + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH)); 1126 P := (POFS => TACKON); 1127 when PREFIX => 1128 SET_COL(F, COL(F) + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH)); 1129 P := (POFS => PREFIX); 1130 when SUFFIX => 1131 SET_COL(F, COL(F) + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH)); 1132 P := (POFS => SUFFIX); 1133 when X => 1134 SET_COL(F, COL(F) + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH)); 1135 P := (POFS => X); 1136 end case; 1137 return; 1138 end GET; 1139 1140 1141 procedure GET(PS : in PART_OF_SPEECH_TYPE; P : out KIND_ENTRY) is 1142 begin 1143 case PS is 1144 when N => 1145 GET(NOUN_KIND); 1146 P := (N, NOUN_KIND); 1147 when PRON => 1148 GET(PRONOUN_KIND); 1149 P := (PRON, PRONOUN_KIND); 1150 when PACK => 1151 GET(PROPACK_KIND); 1152 P := (PACK, PROPACK_KIND); 1153 when ADJ => 1154 SET_COL(COL + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH)); 1155 P := (POFS => ADJ); 1156 when NUM => 1157 GET(NUMERAL_VALUE); 1158 P := (NUM, NUMERAL_VALUE); 1159 when ADV => 1160 SET_COL(COL + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH)); 1161 P := (POFS => ADV); 1162 when V => 1163 GET(VERB_KIND); 1164 P := (V, VERB_KIND); 1165 when VPAR => 1166 GET(VPAR_KIND); 1167 P := (VPAR, VPAR_KIND); 1168 when SUPINE => 1169 GET(SUPINE_KIND); 1170 P := (SUPINE, SUPINE_KIND); 1171 when PREP => 1172 SET_COL(COL + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH)); 1173 P := (POFS => PREP); 1174 when CONJ => 1175 SET_COL(COL + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH)); 1176 P := (POFS => CONJ); 1177 when INTERJ => 1178 SET_COL(COL + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH)); 1179 P := (POFS => INTERJ); 1180 when TACKON => 1181 SET_COL(COL + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH)); 1182 P := (POFS => TACKON); 1183 when PREFIX => 1184 SET_COL(COL + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH)); 1185 P := (POFS => PREFIX); 1186 when SUFFIX => 1187 SET_COL(COL + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH)); 1188 P := (POFS => SUFFIX); 1189 when X => 1190 SET_COL(COL + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH)); 1191 P := (POFS => X); 1192 end case; 1193 return; 1194 end GET; 1195 1196 1197 1198 procedure PUT(F : in FILE_TYPE; 1199 PS : in PART_OF_SPEECH_TYPE; P : in KIND_ENTRY) is 1200 C : POSITIVE := POSITIVE(COL(F)); 1201 begin 1202 case P.POFS is 1203 when N => 1204 PUT(F, P.N_KIND); 1205 when PRON => 1206 PUT(F, P.PRON_KIND); 1207 when PACK => 1208 PUT(F, P.PACK_KIND); 1209 when NUM => 1210 PUT(F, P.NUM_VALUE, NUMERAL_VALUE_TYPE_IO_DEFAULT_WIDTH); 1211 when V => 1212 PUT(F, P.V_KIND); 1213 when VPAR => 1214 PUT(F, P.VPAR_KIND); 1215 when SUPINE => 1216 PUT(F, P.SUPINE_KIND); 1217 when others => 1218 null; 1219 end case; 1220 PUT(F, STRING'((INTEGER(COL(F))..KIND_ENTRY_IO.DEFAULT_WIDTH+C-1 => ' '))); 1221 return; 1222 end PUT; 1223 1224 procedure PUT(PS : in PART_OF_SPEECH_TYPE; P : in KIND_ENTRY) is 1225 C : POSITIVE := POSITIVE(COL); 1226 begin 1227 case P.POFS is 1228 when N => 1229 PUT(P.N_KIND); 1230 when PRON => 1231 PUT(P.PRON_KIND); 1232 when PACK => 1233 PUT(P.PACK_KIND); 1234 when NUM => 1235 PUT(P.NUM_VALUE, NUMERAL_VALUE_TYPE_IO_DEFAULT_WIDTH); 1236 when V => 1237 PUT(P.V_KIND); 1238 when VPAR => 1239 PUT(P.VPAR_KIND); 1240 when SUPINE => 1241 PUT(P.SUPINE_KIND); 1242 when others => 1243 null; 1244 end case; 1245 PUT(STRING'((INTEGER(COL)..KIND_ENTRY_IO.DEFAULT_WIDTH+C-1 => ' '))); 1246 return; 1247 end PUT; 1248 1249 1250 procedure GET(S : in STRING; PS : in PART_OF_SPEECH_TYPE; 1251 P : out KIND_ENTRY; LAST : out INTEGER) is 1252 L : INTEGER := S'FIRST - 1; 1253 begin 1254 LAST := L; -- In case it is not set later 1255 case PS is 1256 when N => 1257 GET(S(L+1..S'LAST), NOUN_KIND, LAST); 1258 P := (N, NOUN_KIND); 1259 when PRON => 1260 GET(S(L+1..S'LAST), PRONOUN_KIND, LAST); 1261 P := (PRON, PRONOUN_KIND); 1262 when PACK => 1263 GET(S(L+1..S'LAST), PROPACK_KIND, LAST); 1264 P := (PACK, PROPACK_KIND); 1265 when ADJ => 1266 P := (POFS => ADJ); 1267 when NUM => 1268 GET(S(L+1..S'LAST), NUMERAL_VALUE, LAST); 1269 P := (NUM, NUMERAL_VALUE); 1270 when ADV => 1271 P := (POFS => ADV); 1272 when V => 1273 GET(S(L+1..S'LAST), VERB_KIND, LAST); 1274 P := (V, VERB_KIND); 1275 when VPAR => 1276 GET(S(L+1..S'LAST), VPAR_KIND, LAST); 1277 P := (VPAR, VPAR_KIND); 1278 when SUPINE => 1279 GET(S(L+1..S'LAST), SUPINE_KIND, LAST); 1280 P := (SUPINE, SUPINE_KIND); 1281 when PREP => 1282 P := (POFS => PREP); 1283 when CONJ => 1284 P := (POFS => CONJ); 1285 when INTERJ => 1286 P := (POFS => INTERJ); 1287 when TACKON => 1288 P := (POFS => TACKON); 1289 when PREFIX => 1290 P := (POFS => PREFIX); 1291 when SUFFIX => 1292 P := (POFS => SUFFIX); 1293 when X => 1294 P := (POFS => X); 1295 end case; 1296 return; 1297 end GET; 1298 1299 1300 procedure PUT(S : out STRING; 1301 PS : in PART_OF_SPEECH_TYPE; P : in KIND_ENTRY) is 1302 L : INTEGER := S'FIRST - 1; 1303 M : INTEGER := 0; 1304 begin 1305 case P.POFS is 1306 when N => 1307 M := L + NOUN_KIND_TYPE_IO.DEFAULT_WIDTH; 1308 PUT(S(L+1..M), P.N_KIND); 1309 when PRON => 1310 M := L + PRONOUN_KIND_TYPE_IO.DEFAULT_WIDTH; 1311 PUT(S(L+1..M), P.PRON_KIND); 1312 when PACK => 1313 M := L + PRONOUN_KIND_TYPE_IO.DEFAULT_WIDTH; 1314 PUT(S(L+1..M), P.PACK_KIND); 1315 when NUM => 1316 M := L + NUMERAL_VALUE_TYPE_IO_DEFAULT_WIDTH; 1317 PUT(S(L+1..M), P.NUM_VALUE); 1318 when V => 1319 M := L + VERB_KIND_TYPE_IO.DEFAULT_WIDTH; 1320 PUT(S(L+1..M), P.V_KIND); 1321 when VPAR => 1322 M := L + VERB_KIND_TYPE_IO.DEFAULT_WIDTH; 1323 PUT(S(L+1..M), P.VPAR_KIND); 1324 when SUPINE => 1325 M := L + VERB_KIND_TYPE_IO.DEFAULT_WIDTH; 1326 PUT(S(L+1..M), P.SUPINE_KIND); 1327 when others => 1328 null; 1329 end case; 1330 S(M+1..S'LAST) := (others => ' '); 1331 end PUT; 1332 1333 1334end KIND_ENTRY_IO; 1335 1336 1337 1338 1339package body TRANSLATION_RECORD_IO is 1340 use TEXT_IO; 1341 use AGE_TYPE_IO; 1342 use AREA_TYPE_IO; 1343 use GEO_TYPE_IO; 1344 use FREQUENCY_TYPE_IO; 1345 use SOURCE_TYPE_IO; 1346 SPACER : CHARACTER := ' '; 1347 --LINE : STRING(1..250); 1348 LAST : INTEGER := 0; 1349 1350 procedure GET(F : in TEXT_IO.FILE_TYPE; TR: out TRANSLATION_RECORD) is 1351 begin 1352 GET(F, TR.AGE); 1353 GET(F, SPACER); 1354 GET(F, TR.AREA); 1355 GET(F, SPACER); 1356 GET(F, TR.GEO); 1357 GET(F, SPACER); 1358 GET(F, TR.FREQ); 1359 GET(F, SPACER); 1360 GET(F, TR.SOURCE); 1361 --GET(F, SPACER); 1362 --GET_LINE(F, LINE, LAST); 1363 --TR.MEAN := HEAD(LINE(1..LAST), MAX_MEANING_SIZE); 1364 end GET; 1365 1366 procedure GET(TR : out TRANSLATION_RECORD) is 1367 begin 1368 GET(TR.AGE); 1369 GET(SPACER); 1370 GET(TR.AREA); 1371 GET(SPACER); 1372 GET(TR.GEO); 1373 GET(SPACER); 1374 GET(TR.FREQ); 1375 GET(SPACER); 1376 GET(TR.SOURCE); 1377 --GET(SPACER); 1378 --GET_LINE(LINE, LAST); 1379 --TR.MEAN := HEAD(LINE(1..LAST), MAX_MEANING_SIZE); 1380 end GET; 1381 1382 procedure PUT(F : in TEXT_IO.FILE_TYPE; TR : in TRANSLATION_RECORD) is 1383 begin 1384 PUT(F, TR.AGE); 1385 PUT(F, ' '); 1386 PUT(F, TR.AREA); 1387 PUT(F, ' '); 1388 PUT(F, TR.GEO); 1389 PUT(F, ' '); 1390 PUT(F, TR.FREQ); 1391 PUT(F, ' '); 1392 PUT(F, TR.SOURCE); 1393 --PUT(F, ' '); 1394 --PUT(F, TR.MEAN); 1395 end PUT; 1396 1397 procedure PUT(TR : in TRANSLATION_RECORD) is 1398 begin 1399 AGE_TYPE_IO.PUT(TR.AGE); 1400 TEXT_IO.PUT(' '); 1401 AREA_TYPE_IO.PUT(TR.AREA); 1402 TEXT_IO.PUT(' '); 1403 GEO_TYPE_IO.PUT(TR.GEO); 1404 TEXT_IO.PUT(' '); 1405 FREQUENCY_TYPE_IO.PUT(TR.FREQ); 1406 TEXT_IO.PUT(' '); 1407 SOURCE_TYPE_IO.PUT(TR.SOURCE); 1408 --TEXT_IO.PUT(' '); 1409 --TEXT_IO.PUT(TR.MEAN); 1410 end PUT; 1411 1412 procedure GET(S : in STRING; TR : out TRANSLATION_RECORD; LAST : out INTEGER) is 1413 L : INTEGER := S'FIRST - 1; 1414 begin 1415 GET(S(L+1..S'LAST), TR.AGE, L); 1416--PUT(TR.AGE); TEXT_IO.PUT('-'); 1417 L := L + 1; 1418 GET(S(L+1..S'LAST), TR.AREA, L); 1419--PUT(TR.AREA); TEXT_IO.PUT('-'); 1420 L := L + 1; 1421 GET(S(L+1..S'LAST), TR.GEO, L); 1422--PUT(TR.GEO); TEXT_IO.PUT('-'); 1423 L := L + 1; 1424 GET(S(L+1..S'LAST), TR.FREQ, L); 1425 --PUT(TR.FREQ); TEXT_IO.PUT('-'); 1426 L := L + 1; 1427 GET(S(L+1..S'LAST), TR.SOURCE, LAST); 1428 --PUT(TR.SOURCE); TEXT_IO.PUT('-'); 1429 --L := M + 1; 1430 --M := L + MAX_MEANING_SIZE; 1431 --TR.MEAN := HEAD(S(L+1..S'LAST), MAX_MEANING_SIZE); 1432 --LAST := M; 1433 end GET; 1434 1435 procedure PUT(S : out STRING; TR : in TRANSLATION_RECORD) is 1436 L : INTEGER := 0; 1437 M : INTEGER := 0; 1438 begin 1439 M := L + AGE_TYPE_IO.DEFAULT_WIDTH; 1440 PUT(S(L+1..M), TR.AGE); 1441 L := M + 1; 1442 S(L) := ' '; 1443 M := L + AREA_TYPE_IO.DEFAULT_WIDTH; 1444 PUT(S(L+1..M), TR.AREA); 1445 L := M + 1; 1446 S(L) := ' '; 1447 M := L + GEO_TYPE_IO.DEFAULT_WIDTH; 1448 PUT(S(L+1..M), TR.GEO); 1449 L := M + 1; 1450 S(L) := ' '; 1451 M := L + FREQUENCY_TYPE_IO.DEFAULT_WIDTH; 1452 PUT(S(L+1..M), TR.FREQ); 1453 L := M + 1; 1454 S(L) := ' '; 1455 M := L + SOURCE_TYPE_IO.DEFAULT_WIDTH; 1456 PUT(S(L+1..M), TR.SOURCE); 1457 --L := M + 1; 1458 --S(L) := ' '; 1459 --M := L + MAX_MEANING_SIZE; 1460 --S(L+1..M) := TR.MEAN; 1461 S(M+1..S'LAST) := (others => ' '); 1462 end PUT; 1463 1464 end TRANSLATION_RECORD_IO; 1465 1466 1467 1468package body DICTIONARY_ENTRY_IO is 1469 use PART_ENTRY_IO; 1470 use TRANSLATION_RECORD_IO; 1471 --use KIND_ENTRY_IO; 1472 1473 SPACER : CHARACTER := ' '; 1474 PART_COL : NATURAL := 0; 1475 1476 DE : DICTIONARY_ENTRY; 1477 1478 procedure GET(F : in FILE_TYPE; D : out DICTIONARY_ENTRY) is 1479 begin 1480 for I in STEM_KEY_TYPE range 1..4 loop 1481 GET(F, D.STEMS(I)); 1482 GET(F, SPACER); 1483 end loop; 1484 GET(F, D.PART); 1485-- GET(F, SPACER); 1486-- GET(F, D.PART.POFS, D.KIND); 1487 GET(F, SPACER); 1488 GET(F, D.TRAN); 1489 GET(F, SPACER); 1490 GET(F, D.MEAN); 1491 end GET; 1492 1493 procedure GET(D : out DICTIONARY_ENTRY) is 1494 begin 1495 for I in STEM_KEY_TYPE range 1..4 loop 1496 GET(D.STEMS(I)); 1497 GET(SPACER); 1498 end loop; 1499 GET(D.PART); 1500-- GET(SPACER); 1501-- GET(D.PART.POFS, D.KIND); 1502 GET(SPACER); 1503 GET(D.TRAN); 1504 GET(SPACER); 1505 GET(D.MEAN); 1506 end GET; 1507 1508 procedure PUT(F : in FILE_TYPE; D : in DICTIONARY_ENTRY) is 1509 begin 1510 for I in STEM_KEY_TYPE range 1..4 loop 1511 PUT(F, D.STEMS(I)); 1512 PUT(F, ' '); 1513 end loop; 1514 PART_COL := NATURAL(COL(F)); 1515 PUT(F, D.PART); 1516-- PUT(F, ' '); 1517-- PUT(F, D.PART.POFS, D.KIND); 1518 SET_COL(F, COUNT(PART_COL + PART_ENTRY_IO.DEFAULT_WIDTH + 1)); 1519 PUT(F, D.TRAN); 1520 PUT(F, ' '); 1521 PUT(F, D.MEAN); 1522 end PUT; 1523 1524 procedure PUT(D : in DICTIONARY_ENTRY) is 1525 begin 1526 for I in STEM_KEY_TYPE range 1..4 loop 1527 PUT(D.STEMS(I)); 1528 PUT(' '); 1529 end loop; 1530 PART_COL := NATURAL(COL); 1531 PUT(D.PART); 1532-- PUT(' '); 1533-- PUT(D.PART.POFS, D.KIND); 1534 SET_COL(COUNT(PART_COL + PART_ENTRY_IO.DEFAULT_WIDTH + 1)); 1535 PUT(D.TRAN); 1536 PUT(' '); 1537 PUT(D.MEAN); 1538 end PUT; 1539 1540 procedure GET(S : in STRING; D : out DICTIONARY_ENTRY; LAST : out INTEGER) is 1541 L : INTEGER := S'FIRST - 1; 1542 M : INTEGER := 0; 1543 I : INTEGER := 0; 1544 begin 1545 for I in STEM_KEY_TYPE range 1..4 loop 1546 STEM_TYPE_IO.GET(S(L+1..S'LAST), D.STEMS(I), L); 1547 end loop; 1548 GET(S(L+1..S'LAST), D.PART, L); 1549-- L := L + 1; 1550-- GET(S(L+1..S'LAST), D.PART.POFS, D.KIND, L); 1551 L := L + 1; 1552 GET(S(L+1..S'LAST), D.TRAN, L); 1553 L := L + 1; 1554 D.MEAN := HEAD(S(L+1..S'LAST), MAX_MEANING_SIZE); 1555 I := L+1; 1556 while S(I) = ' ' loop 1557 I := I + 1; 1558 end loop; 1559 while (S(I) not in 'A'..'Z') and 1560 (S(I) not in 'a'..'z') loop 1561 LAST := I; 1562 I := I + 1; 1563 exit; 1564 end loop; 1565 end GET; 1566 1567 procedure PUT(S : out STRING; D : in DICTIONARY_ENTRY) is 1568 L : INTEGER := S'FIRST - 1; 1569 M : INTEGER := 0; 1570 begin 1571 for I in STEM_KEY_TYPE range 1..4 loop 1572 M := L + MAX_STEM_SIZE; 1573 S(L+1..M) := D.STEMS(I); 1574 L := M + 1; 1575 S(L) := ' '; 1576 end loop; 1577 PART_COL := L + 1; 1578 M := L + PART_ENTRY_IO.DEFAULT_WIDTH; 1579 PUT(S(L+1..M), D.PART); 1580-- L := M + 1; 1581-- S(L) := ' '; 1582-- M := L + KIND_ENTRY_IO_DEFAULT_WIDTH; 1583-- PUT(S(L+1..M), D.PART.POFS, D.KIND); 1584 L := PART_COL + PART_ENTRY_IO.DEFAULT_WIDTH + 1; 1585 M := L + TRANSLATION_RECORD_IO.DEFAULT_WIDTH; 1586 PUT(S(L+1..M), D.TRAN); 1587 L := M + 1; 1588 S(L) := ' '; 1589 M := M + MAX_MEANING_SIZE; 1590 S(L+1..M) := D.MEAN; 1591 S(M+1..S'LAST) := (others => ' '); 1592 end PUT; 1593 1594end DICTIONARY_ENTRY_IO; 1595 1596 1597 1598 1599 1600 function "<=" (LEFT, RIGHT : AREA_TYPE) return BOOLEAN is 1601 begin 1602 if RIGHT = LEFT or else 1603 RIGHT = X then 1604 return TRUE; 1605 else 1606 return FALSE; 1607 end if; 1608 end "<="; 1609 1610 1611begin -- initialization of body of DICTIONARY_PACKAGE 1612--TEXT_IO.PUT_LINE("Initializing DICTIONARY_PACKAGE"); 1613 1614 DICTIONARY_KIND_IO.DEFAULT_WIDTH := DICTIONARY_KIND'WIDTH; 1615 1616 --NUMERAL_VALUE_TYPE_IO.DEFAULT_WIDTH := 5; 1617 1618 AREA_TYPE_IO.DEFAULT_WIDTH := AREA_TYPE'WIDTH; 1619 1620 GEO_TYPE_IO.DEFAULT_WIDTH := GEO_TYPE'WIDTH; 1621 1622 FREQUENCY_TYPE_IO.DEFAULT_WIDTH := FREQUENCY_TYPE'WIDTH; 1623 1624 SOURCE_TYPE_IO.DEFAULT_WIDTH := SOURCE_TYPE'WIDTH; 1625 1626 1627 1628 PARSE_RECORD_IO.DEFAULT_WIDTH := 1629 STEM_TYPE_IO.DEFAULT_WIDTH + 1 + 1630 INFLECTION_RECORD_IO.DEFAULT_WIDTH + 1 + 1631 DICTIONARY_KIND_IO.DEFAULT_WIDTH + 1 + 1632 MNPC_IO_DEFAULT_WIDTH; 1633 NOUN_ENTRY_IO.DEFAULT_WIDTH := 1634 DECN_RECORD_IO.DEFAULT_WIDTH + 1 + 1635 GENDER_TYPE_IO.DEFAULT_WIDTH + 1 + 1636 NOUN_KIND_TYPE_IO.DEFAULT_WIDTH; 1637 PRONOUN_ENTRY_IO.DEFAULT_WIDTH := 1638 DECN_RECORD_IO.DEFAULT_WIDTH + 1 + 1639 PRONOUN_KIND_TYPE_IO.DEFAULT_WIDTH; 1640 PROPACK_ENTRY_IO.DEFAULT_WIDTH := 1641 DECN_RECORD_IO.DEFAULT_WIDTH + 1 + 1642 PRONOUN_KIND_TYPE_IO.DEFAULT_WIDTH; 1643 ADJECTIVE_ENTRY_IO.DEFAULT_WIDTH := 1644 DECN_RECORD_IO.DEFAULT_WIDTH + 1 + 1645 COMPARISON_TYPE_IO.DEFAULT_WIDTH; 1646 ADVERB_ENTRY_IO.DEFAULT_WIDTH := 1647 COMPARISON_TYPE_IO.DEFAULT_WIDTH; 1648 VERB_ENTRY_IO.DEFAULT_WIDTH := 1649 DECN_RECORD_IO.DEFAULT_WIDTH + 1 + 1650 VERB_KIND_TYPE_IO.DEFAULT_WIDTH; 1651 PREPOSITION_ENTRY_IO.DEFAULT_WIDTH := 0; 1652 CONJUNCTION_ENTRY_IO.DEFAULT_WIDTH := 0; 1653 1654 INTERJECTION_ENTRY_IO.DEFAULT_WIDTH := 0; 1655 NUMERAL_ENTRY_IO.DEFAULT_WIDTH := 1656 DECN_RECORD_IO.DEFAULT_WIDTH + 1 + 1657 NUMERAL_SORT_TYPE_IO.DEFAULT_WIDTH + 1 + 1658 NUMERAL_VALUE_TYPE_IO_DEFAULT_WIDTH; 1659 1660 1661 PART_ENTRY_IO.DEFAULT_WIDTH := PART_OF_SPEECH_TYPE_IO.DEFAULT_WIDTH + 1 + 1662 NUMERAL_ENTRY_IO.DEFAULT_WIDTH; -- Largest 1663 1664 1665 1666 -- Should make up a MAX of PART_ENTRY + KIND_ENTRY (same POFS) WIDTHS 1667 1668 1669 TRANSLATION_RECORD_IO.DEFAULT_WIDTH := 1670 AGE_TYPE_IO.DEFAULT_WIDTH + 1 + 1671 AREA_TYPE_IO.DEFAULT_WIDTH + 1 + 1672 GEO_TYPE_IO.DEFAULT_WIDTH + 1 + 1673 FREQUENCY_TYPE_IO.DEFAULT_WIDTH + 1 + 1674 SOURCE_TYPE_IO.DEFAULT_WIDTH; 1675 1676 1677 DICTIONARY_ENTRY_IO.DEFAULT_WIDTH := 4 * (MAX_STEM_SIZE + 1) + 1678 PART_ENTRY_IO.DEFAULT_WIDTH + 1 + 1679 TRANSLATION_RECORD_IO.DEFAULT_WIDTH + 1 + 1680 MAX_MEANING_SIZE; 1681 1682--TEXT_IO.PUT_LINE("Initialized DICTIONARY_PACKAGE"); 1683 1684end DICTIONARY_PACKAGE; 1685