home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / draco / draco-1.ark / QPARSE.DRC < prev    next >
Text File  |  1986-11-12  |  8KB  |  461 lines
  1. #util.g
  2.  
  3. /*
  4.  * QPARSE.DRC - parsing routines for Quest.
  5.  */
  6.  
  7. extern
  8.     _scAbort(*char message)void;
  9.  
  10. type
  11.     DICTENTRY = struct {
  12.     *DICTENTRY d_next;
  13.     *char d_text;
  14.     int d_id;
  15.     int d_type;
  16.     },
  17.  
  18.     FORMTYPE = enum {REQID, REQTYPE, OPTID, OPTTYPE, MULTIPLE},
  19.  
  20.     FORMLIST = struct {
  21.     *FORMLIST f_next;
  22.     FORMTYPE f_kind;
  23.     int f_data;
  24.     },
  25.  
  26.     GRAMMAR = struct {
  27.     *GRAMMAR g_next;
  28.     *FORMLIST g_sentence;
  29.     int g_id;
  30.     },
  31.  
  32.     WORDLIST = struct {
  33.     *WORDLIST wl_next;
  34.     int wl_position;
  35.     int wl_type;
  36.     int wl_id;
  37.     };
  38.  
  39. *DICTENTRY Dictionary;
  40. *GRAMMAR Grammar;
  41. **FORMLIST WordPtr;
  42.  
  43. *WORDLIST InputSentence;
  44. *GRAMMAR MatchedSentence;
  45. *char UnknownWord;
  46. *WORDLIST PrefixList;
  47. int ScanPos;
  48. ushort ScanCount;
  49. bool PrefixEnabled;
  50.  
  51. /*
  52.  * psInit - initialize the parser.
  53.  */
  54.  
  55. proc nonrec psInit(bool prefixEnabled;)void:
  56.  
  57.     PrefixEnabled := prefixEnabled;
  58.     Dictionary := nil;
  59.     Grammar := nil;
  60.     InputSentence := nil;
  61.     UnknownWord := nil;
  62.     PrefixList := nil;
  63.     ScanPos := 0;
  64. corp;
  65.  
  66. /*
  67.  * psWord - add a word to the dictionary.
  68.  */
  69.  
  70. proc nonrec psWord(int id; *char txt; int typ)void:
  71.     *DICTENTRY d;
  72.  
  73.     d := new(DICTENTRY);
  74.     d*.d_next := Dictionary;
  75.     d*.d_text := txt;
  76.     d*.d_id := id;
  77.     d*.d_type := typ;
  78.     Dictionary := d;
  79. corp;
  80.  
  81. /*
  82.  * psDel - delete a word from the dictionary.
  83.  */
  84.  
  85. proc nonrec psDel(int id)void:
  86.     **DICTENTRY pd;
  87.     *DICTENTRY d;
  88.  
  89.     pd := &Dictionary;
  90.     while pd* ~= nil and pd**.d_id ~= id do
  91.     pd := &pd**.d_next;
  92.     od;
  93.     if pd* ~= nil then
  94.     d := pd*;
  95.     pd* := d*.d_next;
  96.     free(d);
  97.     fi;
  98. corp;
  99.  
  100. /*
  101.  * psgBegin - set up to start a new sentence in the grammar.
  102.  */
  103.  
  104. proc nonrec psgBegin(int id)void:
  105.     **GRAMMAR pg;
  106.     *GRAMMAR g;
  107.  
  108.     pg := &Grammar;
  109.     while pg* ~= nil do
  110.     pg := &pg**.g_next;
  111.     od;
  112.     g := new(GRAMMAR);
  113.     g*.g_next := nil;
  114.     g*.g_id := id;
  115.     WordPtr := &g*.g_sentence;
  116.     pg* := g;
  117. corp;
  118.  
  119. /*
  120.  * psgWord - add a word to the current grammar sentence.
  121.  */
  122.  
  123. proc nonrec psgWord(FORMTYPE kind; int data)void:
  124.     *FORMLIST w;
  125.  
  126.     w := new(FORMLIST);
  127.     w*.f_kind := kind;
  128.     w*.f_data := data;
  129.     WordPtr* := w;
  130.     WordPtr := &w*.f_next;
  131. corp;
  132.  
  133. /*
  134.  * psgEnd - end of the current grammar sentence.
  135.  */
  136.  
  137. proc nonrec psgEnd()void:
  138.  
  139.     WordPtr* := nil;
  140. corp;
  141.  
  142. /*
  143.  * psgDel - delete a rule from the grammar.
  144.  */
  145.  
  146. proc nonrec psgDel(int id)void:
  147.     **GRAMMAR pg;
  148.     *GRAMMAR g;
  149.     *FORMLIST f, temp;
  150.  
  151.     pg := &Grammar;
  152.     while pg* ~= nil and pg**.g_id ~= id do
  153.     pg := &pg**.g_next;
  154.     od;
  155.     if pg* ~= nil then
  156.     g := pg*;
  157.     pg* := g*.g_next;
  158.     f := g*.g_sentence;
  159.     free(g);
  160.     while f ~= nil do
  161.         temp := f;
  162.         f := f*.f_next;
  163.         free(temp);
  164.     od;
  165.     fi;
  166. corp;
  167.  
  168. /*
  169.  * CAP - capitalize a letter.
  170.  */
  171.  
  172. proc nonrec CAP(char ch)char:
  173.  
  174.     if ch >= 'a' and ch <= 'z' then
  175.     ch - 32
  176.     else
  177.     ch
  178.     fi
  179. corp;
  180.  
  181. /*
  182.  * psFind - look a word up in the dictionary.
  183.  */
  184.  
  185. proc nonrec psFind(*char wrd)int:
  186.     *DICTENTRY d;
  187.     *char p1, p2;
  188.  
  189.     d := Dictionary;
  190.     while
  191.     if d = nil then
  192.         false
  193.     else
  194.         p1 := wrd;
  195.         p2 := d*.d_text;
  196.         while p1* ~= '\e' and CAP(p1*) = CAP(p2*) do
  197.         p1 := p1 + 1;
  198.         p2 := p2 + 1;
  199.         od;
  200.         CAP(p1*) ~= CAP(p2*)
  201.     fi
  202.     do
  203.     d := d*.d_next;
  204.     od;
  205.     if d = nil then
  206.     0
  207.     else
  208.     d*.d_id
  209.     fi
  210. corp;
  211.  
  212. /*
  213.  * _psLookup - return the DICTENTRY for the indicated word.
  214.  */
  215.  
  216. proc nonrec _psLookup(int id)*DICTENTRY:
  217.     *DICTENTRY d;
  218.  
  219.     d := Dictionary;
  220.     while
  221.     if d = nil then
  222.         _scAbort("psLookup: can't find id.");
  223.     fi;
  224.     d*.d_id ~= id
  225.     do
  226.     d := d*.d_next;
  227.     od;
  228.     d
  229. corp;
  230.  
  231. /*
  232.  * psType - find the type of the word with the given id.
  233.  */
  234.  
  235. proc nonrec psType(int id)int:
  236.  
  237.     _psLookup(id)*.d_type
  238. corp;
  239.  
  240. /*
  241.  * psGet - return the text of the word with the given id.
  242.  */
  243.  
  244. proc nonrec psGet(int id)*char:
  245.  
  246.     _psLookup(id)*.d_text
  247. corp;
  248.  
  249. /*
  250.  * _delimChar - say if a character is a delimiter character.
  251.  */
  252.  
  253. proc nonrec _delimChar(char ch)bool:
  254.  
  255.     not (ch >= 'A' and ch <= 'Z' or ch >= 'a' and ch <= 'z' or
  256.      ch >= '0' and ch <= '9')
  257. corp;
  258.  
  259. /*
  260.  * psParse - parse an input sentence.
  261.  */
  262.  
  263. proc nonrec psParse(*char sentence)int:
  264.     **WORDLIST wp;
  265.     *FORMLIST f;
  266.     *WORDLIST w;
  267.     *char wordStart;
  268.     int data, position;
  269.     char ch;
  270.     bool bad;
  271.  
  272.     /* first, free the previous input sentence list: */
  273.  
  274.     while InputSentence ~= nil do
  275.     w := InputSentence;
  276.     InputSentence := InputSentence*.wl_next;
  277.     free(w);
  278.     od;
  279.     if UnknownWord ~= nil then
  280.     Mfree(pretend(UnknownWord, *byte), CharsLen(UnknownWord) + 1);
  281.     UnknownWord := nil;
  282.     fi;
  283.     while PrefixList ~= nil do
  284.     w := PrefixList;
  285.     PrefixList := PrefixList*.wl_next;
  286.     free(w);
  287.     od;
  288.  
  289.     /* turn the input sentence into a list of words: */
  290.  
  291.     ScanPos := 0;
  292.     wp := &InputSentence;
  293.     bad := false;
  294.     while
  295.     while sentence* = ' ' do
  296.         sentence := sentence + 1;
  297.     od;
  298.     not bad and sentence* ~= '\e'
  299.     do
  300.     if PrefixEnabled and sentence* = ':' and PrefixList = nil then
  301.         /* first part was a prefix: */
  302.         wp* := nil;
  303.         PrefixList := InputSentence;
  304.         wp := &InputSentence;
  305.         sentence := sentence + 1;
  306.     else
  307.         wordStart := sentence;
  308.         sentence := sentence + 1;
  309.         while not _delimChar(sentence*) do
  310.         sentence := sentence + 1;
  311.         od;
  312.         ch := sentence*;
  313.         sentence* := '\e';
  314.         w := new(WORDLIST);
  315.         w*.wl_id := psFind(wordStart);
  316.         if w*.wl_id = 0 then
  317.         UnknownWord := pretend(Malloc(CharsLen(wordStart)+1), *char);
  318.         CharsCopy(UnknownWord, wordStart);
  319.         bad := true;
  320.         else
  321.         w*.wl_type := psType(w*.wl_id);
  322.         fi;
  323.         wp* := w;
  324.         wp := &w*.wl_next;
  325.         sentence* := ch;
  326.     fi;
  327.     od;
  328.     wp* := nil;
  329.  
  330.     /* if an unknown word was found, don't go any further: */
  331.  
  332.     if bad then
  333.     -1
  334.     else
  335.  
  336.     /* check the forms in the grammar for a matching sentence form: */
  337.  
  338.     MatchedSentence := Grammar;
  339.     while
  340.         if MatchedSentence = nil then
  341.         bad := true;
  342.         false
  343.         else
  344.         f := MatchedSentence*.g_sentence;
  345.         w := InputSentence;
  346.         bad := false;
  347.         position := 1;
  348.         while not bad and f ~= nil do
  349.             data := f*.f_data;
  350.             case f*.f_kind
  351.             incase REQID:
  352.             if w ~= nil and data = w*.wl_id then
  353.                 w*.wl_position := position;
  354.                 f := f*.f_next;
  355.                 w := w*.wl_next;
  356.             else
  357.                 bad := true;
  358.             fi;
  359.             incase REQTYPE:
  360.             if w ~= nil and data = w*.wl_type then
  361.                 w*.wl_position := position;
  362.                 f := f*.f_next;
  363.                 w := w*.wl_next;
  364.             else
  365.                 bad := true;
  366.             fi;
  367.             incase OPTID:
  368.             if w ~= nil and data = w*.wl_id then
  369.                 w*.wl_position := position;
  370.                 w := w*.wl_next;
  371.             fi;
  372.             f := f*.f_next;
  373.             incase OPTTYPE:
  374.             if w ~= nil and data = w*.wl_type then
  375.                 w*.wl_position := position;
  376.                 w := w*.wl_next;
  377.             fi;
  378.             f := f*.f_next;
  379.             incase MULTIPLE:
  380.             while w ~= nil and data = w*.wl_type do
  381.                 w*.wl_position := position;
  382.                 w := w*.wl_next;
  383.             od;
  384.             f := f*.f_next;
  385.             esac;
  386.             position := position + 1;
  387.         od;
  388.         if w ~= nil then
  389.             bad := true;
  390.         fi;
  391.         bad
  392.         fi
  393.     do
  394.         MatchedSentence := MatchedSentence*.g_next;
  395.     od;
  396.     if bad then
  397.         0
  398.     else
  399.         MatchedSentence*.g_id
  400.     fi
  401.     fi
  402. corp;
  403.  
  404. /*
  405.  * pspBad - return the unknown word (if any).
  406.  */
  407.  
  408. proc nonrec pspBad()*char:
  409.  
  410.     UnknownWord
  411. corp;
  412.  
  413. /*
  414.  * pspWord - return the (first or any) word which fits the indicated position
  415.  *         in the matched sentence form.
  416.  */
  417.  
  418. proc nonrec pspWord(int pos)int:
  419.     *WORDLIST w;
  420.     ushort i;
  421.  
  422.     if pos ~= ScanPos then
  423.     ScanPos := pos;
  424.     ScanCount := 0;
  425.     fi;
  426.     w := InputSentence;
  427.     while w ~= nil and w*.wl_position < pos do
  428.     w := w*.wl_next;
  429.     od;
  430.     i := ScanCount;
  431.     ScanCount := ScanCount + 1;
  432.     while w ~= nil and i ~= 0 do
  433.     i := i - 1;
  434.     w := w*.wl_next;
  435.     od;
  436.     if w = nil or w*.wl_position ~= pos then
  437.     0
  438.     else
  439.     w*.wl_id
  440.     fi
  441. corp;
  442.  
  443. /*
  444.  * pspPref - return words in the prefix list.
  445.  */
  446.  
  447. proc nonrec pspPref()int:
  448.     *WORDLIST p;
  449.     int id;
  450.  
  451.     if PrefixList = nil then
  452.     0
  453.     else
  454.     p := PrefixList;
  455.     PrefixList := PrefixList*.wl_next;
  456.     id := p*.wl_id;
  457.     free(p);
  458.     id
  459.     fi
  460. corp;
  461.