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