/* PBACK.C Back end for Loglan parser Copyright (C) 1982, 1987 by The Loglan Institute, Inc. Created 82.1.27 Gyro The "back end" builds parse trees and handles things like gu-insertion on error. Modified 8 Mar 87 by JCB to change maximum in PPFindList and PPSkipList from 20 to 25. Also, SWL's fix of the faulty "-o" option installed 24 Mar 87. Modified Jul 87 by RAM to use standard C I/O calls. also dev must be declared as type STREAM instead of short, as it is a long short in the Macintosh and perhaps elsewhere. This should not affect MS/DOS operation. As in other files puts calls have the \n removed as standard C provides one. The routines YYInit and getnum are not required any more as the tables are included automatically with parse.c. nfgets has been replaced by the standard fgets with a different parameter calling order. The other changes in the I..... routines are to standardize I/O function calls. This routine is common to both the IBM and MAcLIPs*/ #pragma once #include "extval.h" #include "va_list.h" short loc; /* The "back end" proper -- functions called by yyparse() and by the grammar actions */ short yylex(void) /* Return the next lexeme to yylex when requested*/ { short next; while(lexemes[curword]/1000 != icont) { /*Is it this level?*/ ++curword; /*No, look at the next word*/ if (curword >= nwords) return (0); /* yyparse end-of-string marker */ } if(curword >= nwords) return (0); /* If there is a next word, and it has a lexeme increment greater than the current level being parsed, it has already been parsed, and its tree is in fullprs. Make a new node with the current leaf and the nested parse tree, and call it 'freemods'. Zero the linked trees so they will not be detected again. Otherwise return the lexeme of the word.*/ if (curword+1 < nwords) { if ((next = lexemes[curword+1]/1000) > icont) { fullprs[next]->n.ngrameme = "freemods"; yylval = ctree(NewNode((TREE *)leaves[curword],fullprs[next])); fullprs[next] = actualprs[next] = humactprs[next] = 0; } else yylval = ctree(leaves[curword]); } else yylval = ctree(leaves[curword]); return (lexemes[curword++]%1000); } void yyerror (char *msg) /* yyparse calls this on errors. Only syntax errors are flagged. */ { if (strcmp (msg, "syntax error") == 0) {} else message(2,13,(unsigned char *)msg); } void PPStart(void) /* Initialize a preparse scan */ { ppiword = 0; ppnmarks = 1; ppprevword = -1; } short PPLexeme (short idx) /* Return th lexeme from current */ { icont = lexemes[ppiword]/1000; /*Get actual lexeme*/ idx += ppiword; /*Find desired location and skip lexemes not in set*/ while (lexemes[idx]/1000 != icont) (idx>ppiword)? ++idx: --idx; if (idx < 0 || idx >= nwords) return (-1); return (lexemes[idx]); } short PPNext(void) /* Return next lexeme in this set */ { icont = lexemes[ppiword]/1000; if (ppiword >= nwords) return (-1); else while (++ppiword < nwords && lexemes[ppiword]/1000 != icont) {}; if (ppiword == nwords) return (-1); return (lexemes[ppiword]); } short PPPrev(void) /* Return previous lexeme in this set */ { icont = lexemes[ppiword]/1000; while (ppiword>0 && lexemes[--ppiword]/1000 != icont){}; if (ppiword <= 0) return (-1); return (lexemes[ppiword]); } void PPDelete(void) /* delete the current lexeme */ { short imark; if (ppiword >= nwords) { alert(2,14); return; } LexDelWd (ppiword); for (imark = 0; imark < ppnmarks; ++imark) if (ppmark[imark] > ppiword) --ppmark[imark]; } void PPJoinNext (char *grameme) /*Join the current lexeme with the next word, and name it grameme.*/ { short curplace; curplace = PPWhere(); /*Find present beginning of string to reduce*/ PPNext(); /*Skip over two words. This will be one past end of string*/ PPNext(); PPJoin (grameme, curplace, PPWhere()); /*Reduce the string*/ } void PPJoin (char *grameme,short left,short right) /* Perform a reduction of a string into a single node labelled grameme, beginning at char left and continuing up to char right */ { short len; /* length of string to reduce */ short curplace; if (!PPMarkOk (left) || !PPMarkOk (right)) return; /*Check if OK*/ left = ppmark[left]; right = ppmark[right]; len = right - left; if (len <= 0) { alert(2,15); return; } leaves[left] = cleaf(Node (grameme, len,(TREE **)&leaves[left]));/*Make node*/ curplace = PPWhere(); /*Fix up string*/ ppiword = left + 1; while (--len > 0) PPDelete(); PPGoto (curplace); } short PPWhere(void) /* Return a mark showing beginning of current word */ { if (ppnmarks > PPMARKMAX) { alert(2,16); return (-1); } ppmark[ppnmarks] = ppiword; return (ppnmarks++); } void PPGoto (short mark) /* Go to a mark (character position) after verification */ { if (PPMarkOk (mark)) ppiword = ppmark[mark]; } Boolean PPMarkOk (short mark) /* Check validity of a mark */ { if (mark < 0 || mark >= ppnmarks || ppmark[mark] < 0 || ppmark[mark] > nwords) { alert(2,17); return (FALSE); } else return (TRUE); } short PPFindList (int list,...) /* Find the first lexeme in the parse sentence which is in list */ { short iarg; int temp; va_list args; repeat { /*Compare each word in turn with components of list*/ va_start( args, list ); temp = list; if (ppiword >= nwords) return (-1); for (iarg = 0; iarg < 25 && temp; ++iarg) { if (lexemes[ppiword]%1000 == temp) break; temp = va_arg(args, int); } if (temp != 0) break; ++ppiword; va_end(); } if (iarg >= 25) { alert(2,18); return (-1); } if (ppiword == ppprevword) { message(2,19,(unsigned char *)leaves[ppiword]->lword); return (-1); } ppprevword = ppiword; icont = lexemes[ppiword]/1000; return (PPLexeme (0)); } short PPSkipList (int list,...) /* Skip lexemes in the parse string which occur in list until one which does not is found */ { short iarg; va_list args; int temp; repeat { va_start( args, list ); // 'list' is the last 'real' parameter temp = list; icont = lexemes[ppiword]/1000; if (ppiword >= nwords) return (-1); for (iarg = 0; iarg < 25 && temp; ++iarg) { if (lexemes[ppiword]/1000 != icont) continue; if (lexemes[ppiword]%1000 == temp) break; temp = va_arg(args, int); } if (iarg >= 25 || temp == 0) break; ++ppiword; va_end(); } if (iarg >= 25) { alert(2,20); /* prevent infinite loops */ ++ppiword; /* prevent infinite loops */ } return (PPLexeme (0)); } TREE *FixVoc(TREE *elm) /* Vocatives are now parsed as terms. However, it is desired ultimately to show them as freemods. To do this, they have to be detached from the tree, and attached to the preceding leaf. Vocatives are labelled by an action during the parse. The tree to be fixed has the pointer elm. */ { short ikid; TREE *ash; ash = NULL; if (IsLeaf(elm)) return NULL; /*arrives here only from recursive calls*/ else if (!IsNode(elm)) alert(0,21); /*Not a tree*/ if (!strcmp("vocative",elm->n.ngrameme)) return(elm);/*No fix needed*/ for (ikid=0; ikidn.nlength; ++ikid) { /*Do kids recursively*/ /*When one is found it must be attached to the previous word. If it is not the first kid at this level, attach to the preceding kid, and return NULL which indicates completion. Otherwise return the vocative part-tree to the next higher level of the tree, until an elder kid can be found to which it can be attached*/ if ((ash=FixVoc(elm->n.nkids[ikid]))!=NULL) { if (elm->n.nkids[ikid]==ash) detach(elm,ikid); if(ikid) { attach(ash,elm->n.nkids[ikid-1],elm,ikid); return NULL; } else return(ash); } } return NULL; } void detach(TREE *elm, short ikid) /*Detach part-tree ikid from a part tree with root elm, by shifting all higher kids one place to the left, and reducing the kid count.*/ { short i; for (i=ikid; in.nlength; ++i) elm->n.nkids[ikid] = elm->n.nkids[ikid+1]; --elm->n.nlength; } void attach(TREE *ash,TREE *elm,TREE *yew, short ikid) /*Attach ash which is kid ikid to youngest leaf of elm, which is a kid of yew. If elm is a leaf, it ash can be attached immediately, otherwise, we must descend the tree, looking at the youngest kid at each level until a leaf is found to which ash can be attached. */ { short ind; if (IsLeaf(elm)) yew->n.nkids[ikid-1] = (TREE *)NewNode(elm,ash); else if (!IsNode(elm)) alert(0,21); else { ind = elm->n.nlength; attach(ash,elm->n.nkids[ind-1],elm,ind); } } LEAF *LeafI (short lex,char *wd) /* Make an "invisible" leaf of wd having lexeme lex. Used for inserting right-end punctuation. */ { return (Leaf (wd,lex, WINVISIBLE)); } LEAF *Leaf (char *wd,short lex, char source) /* Make a leaf from wd having lexeme lex, and characteristic source*/ { LEAF *tleaf; tleaf = cleaf(AAlloc (sizeof(*tleaf) + strlen (wd))); /*Get space*/ if (!tleaf) alert(0,12); /*No room*/ tleaf->type = LEAFTYPE; /*Set fields and return a pointer*/ tleaf->lexeme = lex; tleaf->lsource = source; strcpy (tleaf->lword, wd); return (tleaf); } NODE *NodeY1 (char *grameme, TREE **yypv) /* Make a 1-child node. A parsing action */ { return (NodeY (grameme, 1, yypv)); } NODE *NodeY2 (char *grameme, TREE **yypv) /* Make a 2-child node. A parsing action */ { return (NodeY (grameme, 2, yypv)); } NODE *NodeY3 (char *grameme, TREE **yypv) /* make a 3-child node */ /* Make a 3-child node. A parsing action */ { return (NodeY (grameme, 3, yypv)); } NODE *NodeA (char *grameme,short length,LEAF *kidlist) /* make an n-child node from arguments */ /* Make an n-child node from arguments. A parsing action used for inserting right-hand punctuation leaves into the tree */ { return (Node (grameme, length,(TREE **) &kidlist)); } NODE *NodeY (char *grameme, short length, TREE **yypv) /* make an n-child node from internal yyparse ptr */ { return (Node (grameme, length, yypv - length + 1)); } NODE *Node (char *grameme,short length, TREE **kids) /*This is the parent node producing routine. Produce a node having grameme grameme, and length kids, whose pointers are in an array kids*/ { NODE *tnode; short ikid; tnode = cnode(AAlloc (sizeof(*tnode) + length * sizeof(*kids))); if (!tnode) alert(0,12); tnode->type = NODETYPE; tnode->ngrameme = grameme; tnode->nlength = length; for (ikid = 0; ikid < length; ++ikid) tnode->nkids[ikid] = kids[ikid]; return (tnode); } Boolean vocfind(TREE *trmnode) /*This is an action called by the parser. The partial tree trmnode is searched recursively for a grameme 'voc'. If one is found the node is labelled 'vocative'*/ { short i,leng; if (IsLeaf(trmnode)) return FALSE; if (!IsNode(trmnode)) alert(0,21); else if (!strcmp(trmnode->n.ngrameme,"voc")) { flagname(trmnode); return TRUE; } else { leng = trmnode->n.nlength; for (i=0; in.nkids[i])) return TRUE; return FALSE; } return FALSE; } void flagname(TREE *trm) /* The partial tree trm is searched recursively for leaves containing names. These leaves are flagged so that the names may be written as |DJAN| */ { short ikid; if (IsLeaf(trm) && trm->l.lexeme==DJAN) trm->l.lsource=WCONT; else if (IsNode(trm)) for (ikid=0; ikidn.nlength; ++ikid) flagname(trm->n.nkids[ikid]); } NODE *NewNode (TREE *kid1,TREE *kid2) /* This tree inserts freemods into the tree by making a freemod node from 2 kids. An empty grameme is used, which is a signal to the parse writer to omit the grouping markers which would normally surround a node. */ { NODE *tnode; tnode = cnode(AAlloc (sizeof(*tnode) + 2 * sizeof(*kid1))); if (!tnode) alert(0,12); tnode->type = NODETYPE; tnode->ngrameme = ""; tnode->nlength = 2; tnode->nkids[0] = kid1; tnode->nkids[1] = kid2; return (tnode); } NODE *NodeCopy (TREE *n) /* Make a copy of node n for tree flattening or gu removing. */ { return (Node (n->n.ngrameme, n->n.nlength, n->n.nkids)); } /*----------------------------------------------------------------*/ /* Misc. tree-hacking stuff, including printing */ void TreeInit(void) /* Initialize the parse-tree builder */ { AInit (); } void TreeList (TREE *oak) /* Print a tree as a list of trees. Seems to be used now only for printing the preparse strings (leaves only) */ { Tree_List (oak,0,0); } void TreeString (TREE *oak,short n) /*As above, but suppress outer parens. This is the general routine for producing a linear parse. Oak is the root of the tree, n a flag indicating whether lexemes must be desubscripted or not. */ { loc = 0; Tree_List (oak,-1,n); } void Tree_List (TREE *oak,short depth,short n) /* Internal to the above TreeList. Oak is the tree to list, depth the degree of recursion and n a flag indicating if desubscripting is to be done n = 2 or lexemes to be printed instead of words (n>0). This is the so-called 'linear' parse.*/ { short ikid,lex; char chr; if (IsLeaf (oak)) { lex = oak->l.lexeme%1000; if (n) { /*Print a leaf as lexeme, desubscripting if desired*/ if (n == 2) lex = Fixlex(lex); nfputs ((unsigned char *)lexnames[lex - 257],0); } else { /*Print the Loglan word*/ /* Freemods are marked with vertical bars on each side */ if (lex == UI || lex == JO || lex == DIE || (lex == DJAN && oak->l.lsource == WCONT)) { nfputc('|'); } nfputs ((unsigned char *)oak->l.lword,0); if (lex == UI || lex == JO || lex == DIE || (lex == DJAN && oak->l.lsource == WCONT)) nfputc('|'); } ++loc; } else if (IsNode (oak)) { /*Nodes always call for punctuation of some sort*/ ikid = 0; chr = oak->n.ngrameme[0]; /*gramemes freemod(s) and voc(ative) are marked with vertical bars*/ if (chr == 'f' || chr == 'v') nfputc('|'); /*others with a punctuation mark dependent on depth unless it is a freemod node, in which case the punctuation pair is omitted. Vocatives are identified with hasvoc, and other freemods by a null grameme.*/ else if (!hasvoc(oak) && strlen(oak->n.ngrameme)) { #ifndef DOS if (depth >= 0) nfputc ("([{<«"[depth]); #else if (depth >= 0) nfputc ("([{<"[depth]); #endif } repeat { /*Do it recursively for all the kids*/ if (ikid >= oak->n.nlength) break; if (ikid > 0) nfputc (' '); #ifdef DOS Tree_List (oak->n.nkids[ikid],(depth + 1) % 4,n); #else Tree_List (oak->n.nkids[ikid],(depth + 1) % 5,n); #endif ++ikid; } /*Then put the closing member of the punctuation pair*/ if (chr == 'f' || chr == 'v') nfputc('|'); else if (!hasvoc(oak) && strlen(oak->n.ngrameme)) { #ifndef DOS if (depth >= 0) nfputc (")]}>»"[depth]); #else if (depth >= 0) nfputc (")]}>"[depth]); #endif } } else alert(2,21); } Boolean hasvoc(TREE *spruce) /*Hasvoc examines the partial tree spruce to see if a vocative freemod node is present. If true it should be a kid in a node with 2 members, and its grameme should begin with 'v'. It is not recursive as a partial tree is examined at each level */ { TREE *pine,*ash; if (IsLeaf(spruce)) return FALSE; if (!IsNode(spruce)) alert(0,21); /*Invalid node*/ if (spruce->n.nlength !=2) return FALSE; /*vocs are always 2-nodes*/ pine = spruce->n.nkids[0]; ash = spruce->n.nkids[1]; if (IsNode(pine) && pine->n.ngrameme[0]=='v') return TRUE; if (IsNode(ash) && ash->n.ngrameme[0]=='v') return TRUE; return FALSE; } void TreeDsp (TREE *oak,Boolean nounary) { Tree_Dsp (oak,0, nounary); #ifdef MAC nfputc(CR); #endif } void Tree_Dsp (TREE *oak,short depth,Boolean nounary) /* internal to above */ /* Display a tree oak, as a tree, Depth is the degree of recursion. If the flag nounary is true, suppress all unary reductions. If it has the value 2, suppress all gramemes and print only the Loglan word and lexeme. This routine is internal to the above. */ { short i,style; /* Place depth markers to make it easier for the user to determine matching depths*/ if (nounary !=2) for (i = 0; i < depth; ++i) nfputs((unsigned char *)"| ",0); if (IsLeaf (oak)) { /*Display the Loglan word with its lexeme*/ if (nounary==2) for (i = 0; i < depth; ++i) nfputs((unsigned char *)"|---",0); nfputs ((unsigned char *)oak->l.lword,3); nfputs ((unsigned char *)" = ",3); if (!lexnames[oak->l.lexeme%1000-257]) nfputs ((unsigned char *)"Loan",3); else nfputs ((unsigned char *)lexnames[oak->l.lexeme%1000-257],3); #ifdef DOS nfputs ((unsigned char *)"\n\r ",3); #else nfputs((unsigned char *)" ",3); nfputc (CR); #endif } else if (IsNode (oak)) { /*Node increases depth and starts recursion*/ if (!strlen(oak->n.ngrameme)) { /*Freemods stay at same depth*/ --depth; goto kiddo; } style = 2; /*Output font*/ repeat { if (nounary != 2) { /*Print the grameme, when wanted*/ nfputs ((unsigned char *)oak->n.ngrameme,style); nfputs ((unsigned char *)": ",style); } if (!IsUnary (oak)) break; /*If not unary, continue recursion*/ else if(nounary) { /*If unary desired, print them*/ style = 1; while(IsUnary(oak)) oak=oak->n.nkids[0]; } else { /*Skip the unary and set the tree to the kid*/ oak = oak->n.nkids[0]; style = 1; /*and change the font (if available)*/ } } kiddo: if (nounary != 2) { /*A new line for each non-unary reduction*/ #ifdef DOS nfputs ((unsigned char *)"\n\r ",0); #else TextSize(12); nfputc (CR); #endif } for (i = 0; i < oak->n.nlength; ++i) /*and recurse*/ Tree_Dsp (oak->n.nkids[i],depth + 1, nounary); } else alert(2,21); } Boolean IsUnary (TREE *oak) /* Does this node dominate just another node? */ { return (oak->n.nlength == 1 && IsNode (oak->n.nkids[0])); } /* TreePPList (oak) yet another output style TREE *oak; This routine and the following one are the actual code for a type of output no longer included in the menu. The code has been left in the listing for historical reasons, in case it should be wanted again. { Tree_PPList (oak,0); } Tree_PPList (oak,col) internal to the above TREE *oak; short col; { short ikid, tcol, i; if (IsLeaf (oak)) { nfputs ((unsigned char *)oak->l.lword,0); return (col + strlen (oak->l.lword)); } else if (IsNode (oak)) { ikid = 0; nfputc ('('); ++col; tcol = col; repeat { if (ikid >= oak->n.nlength) break; if (ikid > 0) if (tcol < 0) { nfputc (NL); for (i = 0; i < col; ++i) nfputc (' '); tcol = col; } else { nfputc (' '); col = ++tcol; } tcol = Tree_PPList (oak->n.nkids[ikid],col); ++ikid; } nfputc (')'); return (-1); } else alert(2,21); } */ short IsLeaf (TREE *oak) /* Is this a leaf? */ { return (oak->l.type == LEAFTYPE); } short IsNode (TREE *birch) /* Is this a node? */ { return (birch->n.type == NODETYPE); } TREE *TreeFlatten (TREE *oak) /* Remove structurally-redundant nodes for linear type displays (i.e. unary reductions) */ { short ikid; NODE *tnode; if (IsLeaf (oak)) return (oak); if (oak->n.nlength == 1) return (TreeFlatten (oak->n.nkids[0])); tnode = NodeA (oak->n.ngrameme, oak->n.nlength,NULL); for (ikid = 0; ikid < oak->n.nlength; ++ikid) tnode->nkids[ikid] = TreeFlatten (oak->n.nkids[ikid]); return (ctree(tnode)); } Boolean IGetField (char *dest) /* Get a space-delimited field from string ic into string dest*/ { ISkipSpc(); *dest = NUL; if (!*ic) return (FALSE); while (*ic && !isspace (*ic)) *dest++ = *ic++; *dest = NUL; return (TRUE); } Boolean IGetToken (char *dest) /* Get a delimited token from string ic into string dest*/ { return IGetTkn(dest,NULL); } Boolean IGetTkn (char *dest,char *ictemp) /* Get a delimited token from string ic into string dest, joining LWs*/ { char fp,fn,fc,*destem; if (*ic != ',' && *ic != '#') ISkipMsc(); *dest = NUL; destem = dest; fp = FALSE; if (!*ic) return (FALSE); repeat { if (IsCons(*ic) && IsCons(*(ic+1))) fp = TRUE; fn = (IsVowel(*ic))? FALSE:TRUE; fc = (*ic==',' || *ic=='#')? TRUE:FALSE; *dest++ = *ic++; *dest = NUL; if (*ic==',' && isalpha(*(ic+1))) continue; if (*ic==SP && !strcmp(destem,"lie")) return TRUE; if (*ic==SP && !strcmp(destem,"lao")) return TRUE; if (*ic==SP && !strcmp(destem,"sue")) return TRUE; if (*ic==SP && !fp && !fn && !fc) { ictemp = ic++; return (IGetTkn(dest,ictemp)); } if (IsBreak(*ic)) break; } if (ictemp != NULL && (fp || fn || fc)) { ic = ictemp; *destem = NUL; /*Ends the combining*/ return (TRUE); } return (TRUE); } Boolean IsBreak (char c) /* Is c a token break character? (Not alphanumeric, \ or : )*/ { return (c!='\'' && c!=':' && !(isalpha (c) && !isdigit (c))); } void ISkipMsc(void) /* Skip non Ascii */ { while ((*ic && !isalpha (*ic)) || *ic == '.') ++ic; } void ISkipSpc(void) /* Skip whitespace */ { while (*ic && isspace (*ic)) ++ic; } Boolean IMatch (char *s) /* does input match string ? */ { char *tic; tic = ic; while (*s) if (*tic++ != *s++) return (FALSE); ic = tic; /* if match, advance input pointer */ return (TRUE); } /* End of PBACK.C */