/* ----------------------------------------------------------
% (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);
}
syntax highlighted by Code2HTML, v. 0.9.1