/* ---------------------------------------------------------- % (C)1992 Institute for New Generation Computer Technology % (Read COPYRIGHT for detailed information.) ----------------------------------------------------------- */ /*===================================================================== * cu-Prolog III (Constraint Unification Prolog) * Copyright: Institute for New Generation Computer Technology,Japan * 1989--91 ==================================================================== */ /*-------------------------------------------------------------------- * << jpsgsub.c >> * (system predicates for JPSG parser) --------------------------------------------------------------------*/ #include "include.h" /* tree() system predicate */ void Ptree(),treeprint(),oldlink(),PCat(),Psubcat(); int null_or_nil(); #define TREEMAX 20 /* tree depth max */ int treehist[TREEMAX]; int Category_size = 0; #define CATMAX 30 int cattype[CATMAX]; char catname[CATMAX][10]; /* category name */ /* category type */ #define Normal 1 #define CatSingle 2 #define CatSet 3 void show_category() /* for debug */ { register int i; tputc('['); for (i = 0; ;) { tprint2("%s,%d",catname[i],cattype[i]); i++; if (i >= Category_size) break; tputc(','); } tputc(']'); } void init_category() { Category_size = CAT_P->f_arity = 6; strcpy(catname[0],"POS");cattype[0] = Normal; strcpy(catname[1],"FORM");cattype[1] = Normal; strcpy(catname[2],"AJA");cattype[2] = CatSingle; strcpy(catname[3],"AJN");cattype[3] = CatSingle; strcpy(catname[4],"SC");cattype[4] = CatSet; strcpy(catname[5],"SEM");cattype[5] = Normal; } void list_to_cat(t0,n) /* set cattype[],catname[] */ struct term *t0; int n; { register int i; register struct term *t; for (t = t0, i = 0; i < n; i++, t = Arg(t,1)) { if (! is_list(t)) error("illegal format (feature type)"); if (!isvar(head_of_list(t))) error("illegal feature name"); strcpy(catname[i],vname(head_of_list(t))); t = tail_of_list(t); if (! is_list(t)) error("illegal format (feature type)"); if (!is_num(head_of_list(t))) error("illegal feature type"); cattype[i] = num_value(head_of_list(t)); } } void set_category() /* %C command */ { struct term *t; v_number = 0; v_list = NULL; advance; t = Rterm(1200,TEMPORAL); skipline; if ((v_number < 3) || (v_number > 30)){ tprint0("illegal feature number (>3,<30)"); init_category(); return; } list_to_cat(t,v_number); Category_size = v_number; CAT_P->f_arity = v_number; } int tree_pred(t,e) struct term *t; struct pair *e; { Ptree(Arg(t,0),e); return(SYSTRUE); } void Ptree(t,e) /* print tree entry */ struct term *t; struct pair *e; { int i; struct pair *p; down(p,t,e); if (t->type.t_func != T_P) { Pterm(t,e); return; } for (i = 0; i < TREEMAX; i++) treehist[i] = 0; /* array initialize */ treeprint(t,e,0);NL; } void oldlink(n) /* print old link in depth n */ int n; { int i; tprint0(" "); for (i = 0; i < n; i++) { if (treehist[i] != 0) { tprint0("| "); } else { tprint0(" "); } } } void treeprint(t,e,n) /* print tree main */ struct term *t; struct pair *e; int n; /* depth */ { struct pair *p; down(p,t,e); if ((t->type.t_func != T_P) || (n > TREEMAX) ){ PCat(t,e,0); return; } treeprint(Arg(t,0),e,n + 1); if (Arg(t,2) == NIL) { tprint0("---"); Pterm(Arg(t,1),e); return; } NL; treehist[n] = 1; oldlink(n);tprint0("| ");NL; oldlink(n);tprint0("|--");treeprint(Arg(t,1),e,n + 1);NL; oldlink(n);tprint0("| ");NL; treehist[n] = 0; oldlink(n);tprint0("|__");treeprint(Arg(t,2),e,n + 1); } int null_or_nil(t,e) register struct term *t; register struct pair *e; { register struct pair *p; down(p,t,e); if (t == NULL) return(TRUE); else if (t == NIL) return(TRUE); else return(FALSE); } void PCat(t,e,f) /* print category */ struct term *t; struct pair *e; int f; /* if f = 1 ,does not print SEM */ { struct pair *p; register int i; down(p,t,e); if (t->type.t_func != CAT_P) { Pterm(t,e); return; } Pterm(Arg(t,0),e); /* print pos */ tprint0("["); Pterm(Arg(t,1),e); /* print form */ if (f == 1) { tputc(']'); return; } for (i = 2; i < (Category_size -1); i++) { if (null_or_nil(Arg(t,i),e)) continue; tprint1(", %s:",catname[i]); if (cattype[i] == CatSingle) Psubcat(Arg(t,i),e); else if (cattype[i] == CatSet) { tputc('{'); Psubcat(Arg(t,i),e); tputc('}'); } else Pterm(Arg(t,i),e); /* type = Normal */ } tprint0("]:"); Pterm(Arg(t,Category_size - 1),e); /* print sem */ } void Psubcat(t,e) /* print subcat etc. */ struct term *t; struct pair *e; { struct pair *p; down(p,t,e); if (t == NIL) return; if (t == NULL) return; if (p != NULL){ /* if t is var */ /* Pterm(t,e); */ tprint1("%s",vname(t)); return; } if (! is_list(t)) { tputc('?'); /* Pterm(t,e); */ return; } PCat(head_of_list(t),e,1); if (tail_of_list(t) == NIL) return; tprint0(", "); Psubcat(tail_of_list(t),e); } #define CnstMax 20 char *cnametmp[CnstMax]; /* work array */ char *termname(t,e) /* return functor name of t */ struct term *t; struct pair *e; { struct pair *p; down(p,t,e); if (p != NULL) return(vname(t)); /* if t is var */ return(t->type.t_func->f_name); } int pickname(t,e) /* pick up constraint name in cnametmp[] */ struct term *t; struct pair *e; { struct pair *p; int i; for (i = 0;;i++){ down(p,t,e); if (t == NIL) return(i); if (t == NULL) return(i); if (! is_list(t)){ tprint0("constraint error"); return(0); } cnametmp[i] = termname(head_of_list(t),e); t = tail_of_list(t); } } struct term *cnlistmake(n) int n; { int i; struct term *listtop; struct term *t,*ct; for(i = 0,listtop = NIL; i < n; i++){ ct = Nterm(0,ETERNAL); ct->type.t_func = Nfunc(USERFUN,cnametmp[i],0); t = (struct term *)Nlist(ct,(struct clause *)listtop,TEMPORAL); listtop = t; } return(listtop); } int cname_pred(t,e,nn) /* construct constraint list cnst->cn */ struct term *t; struct pair *e; struct node *nn; { struct term *cnst,*cn; struct pair *e1,*q; int n; cnst = Arg(t,0); cn = Arg(t,1); e1 = e; down(q,cn,e1); if (q == NULL) return(SYSFAIL); /* if cn isn't var */ n = pickname(cnst, e); if (n > CnstMax) n = CnstMax; q->p_body = cnlistmake(n); return(SYSTRUE); }