ftp.nice.ch/pub/next/unix/developer/pcn.2.0.s.tar.gz#/src/compiler/parser/pcn_parse.c

This is pcn_parse.c in view mode; [Download] [Up]

#include "co_parse.h"

#define INDENT do_indent(stdout, indent)
#ifndef INDENT_LEVEL
#define INDENT_LEVEL 2
#endif

static void do_indent(fp, i)  FILE *fp; int i;
{
    int j;

    fprintf(fp, "%2d ", i / INDENT_LEVEL);
    for (j = 0; j < i; j++)
	fputs(" ", fp);
}

static char *str_save(s)
char *s;
{
    char *rc = (char *) malloc(strlen(s) + 1);
    strcpy(rc, s);
    return rc;
}

static datum *
datum_alloc(type)  int type;
{
    datum *rc = (datum *) malloc(sizeof(datum));

    D_TYPE(rc) = type;
    return rc;
}

static tuple *
tuple_alloc(n)  int n;
{
    tuple *rc = (tuple *) malloc(sizeof(tuple));

    T_NARGS(rc) = n;
    T_ARGS(rc) = (datum **) malloc(sizeof(datum *) * n);
    return rc;
}

static list *list_alloc()
{
    list *rc = (list *) malloc(sizeof(list));

    return rc;
}

datum *
_p_co_new_integer(i)  int i;
{
    datum *rc = datum_alloc(D_INTEGER);
    D_IVAL(rc) = i;
    return rc;
}

datum *
_p_co_new_tag(i)  int i;
{
    datum *rc = datum_alloc(D_TAG);
    D_IVAL(rc) = i;
    return rc;
}

/*
datum *_p_co_new_double(double d)
{
    datum *rc = datum_alloc(D_DOUBLE);
    D_DVAL(rc) = d;
    return rc;
}
*/

datum *
_p_co_new_string(s)  char *s;
{
    datum *rc = datum_alloc(D_STRING);

    D_SVAL(rc) = str_save(s);
    return rc;
}

datum *
_p_co_new_string_len(s, len)  char *s; int len;
{
    datum *rc = datum_alloc(D_STRING);

    D_SVAL(rc) = (char *) malloc(len + 1);
    strncpy(D_SVAL(rc), s, len);
    D_SVAL(rc)[len] = '\0';
    return rc;
}

datum *
_p_co_new_tuple_1(a1)  datum *a1;
{
    datum *rc = datum_alloc(D_TUPLE);
    D_TVAL(rc) = tuple_alloc(1);
    D_ARG(rc, 0) = a1;
    return rc;
}

datum *
_p_co_new_tuple_2(a1, a2)  datum *a1; datum *a2;
{
    datum *rc = datum_alloc(D_TUPLE);
    D_TVAL(rc) = tuple_alloc(2);
    D_ARG(rc, 0) = a1;
    D_ARG(rc, 1) = a2;
    return rc;
}

datum *
_p_co_new_tuple_3(a1, a2, a3)  datum *a1; datum *a2; datum *a3;
{
    datum *rc = datum_alloc(D_TUPLE);
    D_TVAL(rc) = tuple_alloc(3);
    D_ARG(rc, 0) = a1;
    D_ARG(rc, 1) = a2;
    D_ARG(rc, 2) = a3;
    return rc;
}

datum *
_p_co_new_tuple_4(a1, a2, a3, a4)  datum *a1; datum *a2; datum *a3; datum *a4;
{
    datum *rc = datum_alloc(D_TUPLE);
    D_TVAL(rc) = tuple_alloc(4);
    D_ARG(rc, 0) = a1;
    D_ARG(rc, 1) = a2;
    D_ARG(rc, 2) = a3;
    D_ARG(rc, 3) = a4;
    return rc;
}

datum *
_p_co_new_tuple_5(a1, a2, a3, a4, a5)  datum *a1; datum *a2; datum *a3; datum *a4; datum *a5;
{
    datum *rc = datum_alloc(D_TUPLE);
    D_TVAL(rc) = tuple_alloc(5);
    D_ARG(rc, 0) = a1;
    D_ARG(rc, 1) = a2;
    D_ARG(rc, 2) = a3;
    D_ARG(rc, 3) = a4;
    D_ARG(rc, 4) = a5;
    return rc;
}

datum *
_p_co_new_tuple(n)  int n;
{
    datum *rc = datum_alloc(D_TUPLE);
    D_TVAL(rc) = tuple_alloc(n);
    return rc;
}

datum *
_p_co_new_quoted_block(block)  datum *block;
{
    datum *rc = datum_alloc(D_QUOTED_BLOCK);
    D_TVAL(rc) = tuple_alloc(1);
    D_ARG(rc, 0) = block;
    return rc;
}


datum *_p_co_nil()
{
    return datum_alloc(D_NIL);
}


datum *
_p_co_set_arg(t, n, val)  datum *t; int n; datum *val;
{
    D_TVAL(t)->args[n] = UNLIST(val);
    return t;
}

datum *
_p_co_get_arg(t, n)  datum *t; int n;
{
    return D_TVAL(t)->args[n];
}
       
datum *
_p_co_cons(car, cdr)  datum *car; datum *cdr;
{
    datum *rc = _p_co_new_tuple(2);

    _p_co_set_arg(rc, 0, car);
    _p_co_set_arg(rc, 1, cdr);

    return rc;
}

datum *
_p_co_new_list(elt)  datum *elt;
{
    datum *rc = datum_alloc(D_LIST);
    datum *head;

    D_LVAL(rc) = list_alloc();

    D_LHEAD(rc) = head = _p_co_cons(elt, _p_co_nil());
    D_LTAIL(rc) = &(D_ARG(head, 1));

    return rc;
}

datum *
_p_co_new_list_0()
{
    datum *rc = datum_alloc(D_LIST);

    D_LVAL(rc) = list_alloc();

    return rc;
}

datum *
_p_co_append_list(lst, elt)  datum *lst; datum *elt;
{
    datum *new_tail;
    
    if (D_TYPE(lst) == D_NIL)
    {
	return _p_co_new_list(elt);
    }
    else if (D_TYPE(lst) != D_LIST)
    {
	fprintf(stderr, "FATAL: _p_co_append_list not passed a list (%d instead)\n",
		D_TYPE(lst));
	exit_from_c(1);
    }
    
    new_tail = _p_co_cons(elt, _p_co_nil());

    *(D_LTAIL(lst)) = new_tail;
    D_LTAIL(lst) = &(D_ARG(new_tail, 1));

    return lst;
}

int 
is_list(t)  datum *t;
{
    extern char *getenv();

    if (getenv("NO_LISTS"))
	return 0;
    
    switch (D_TYPE(t))
    {
    case D_LIST:
	return is_list(D_LHEAD(t));

    case D_NIL:
	return 1;

    case D_TUPLE:
	if (D_NARGS(t) == 2 && !D_IS_TAG(D_CAR(t)))
	    return is_list(D_CDR(t));
	else
	    return 0;

    default:
	return 0;
    }
}

int 
is_flat_tuple(t)  datum *t;
{
    int i;

    for (i = 0; i < D_NARGS(t); i++)
    {
	if (D_IS_TUPLE(D_ARG(t, i)) || D_IS_LIST(D_ARG(t, i)) || D_IS_QUOTED_BLOCK(D_ARG(t, i)))
	    return 0;
    }
    return 1;
}

int 
is_flat_list(t)  datum *t;
{
    int i;
    datum *l;

    for (l = t; D_IS_TUPLE(l); l = D_CDR(l))
    {
	if (D_IS_TUPLE(D_CAR(l)) || D_IS_LIST(D_CAR(l)) || D_IS_QUOTED_BLOCK(D_CAR(l)))
	    return 0;
    }
    return 1;
}

void 
_p_co_print1_nonl(t)  datum *t;
{
    int i;

    if (t == NULL)
    {
	printf("<<NULL DATUM>>");
	return;
    }
    switch (D_TYPE(t))
    {
    case D_TAG:
	printf("%s", tagnames[D_IVAL(t)]);
	break;

    case D_INTEGER:
	printf("%d", D_IVAL(t));
	break;

    case D_DOUBLE:
	printf("%lf", D_DVAL(t));
	break;

    case D_STRING:
	printf("\"%s\"", D_SVAL(t));
	break;

    case D_TUPLE:
    case D_LIST:
    case D_QUOTED_BLOCK:
	printf("<<TUPLE>>");
	break;

    case D_NIL:
	printf("[]");
	break;

    default:
	printf("ERROR: unknown type %d in _p_co_print\n",
	       D_TYPE(t));
    }
}

void 
_p_co_print1(t, indent)  datum *t; int indent;
{
    int i;

    INDENT;
    if (t == NULL)
    {
	printf("NULL DATUM\n");
	return;
    }
    switch (D_TYPE(t))
    {
    case D_TAG:
	printf("%s\n", tagnames[D_IVAL(t)]);
	break;

    case D_INTEGER:
	printf("%d\n", D_IVAL(t));
	break;

    case D_DOUBLE:
	printf("%lf\n", D_DVAL(t));
	break;

    case D_STRING:
	printf("\"%s\"\n", D_SVAL(t));
	break;

    case D_QUOTED_BLOCK:
	printf("QUOTED_BLOCK\n");
	_p_co_print1(D_ARG(t, 0), indent + INDENT_LEVEL);
	break;

    case D_TUPLE:
	if (is_list(t))
	{
	    if (is_flat_list(t))
	    {
 		datum *l;
		
		printf("[");
		
		for (l = t; D_IS_TUPLE(l);)
		{
		    _p_co_print1_nonl(D_CAR(l));
		    l = D_CDR(l);
		    if (D_IS_TUPLE(l))
			printf(", ");
		}
		printf("]\n");
	    }
	    else
	    {
 		datum *l;
		
		printf("[\n");
		
		for (l = t; D_IS_TUPLE(l);)
		{
		    _p_co_print1(D_CAR(l), indent + INDENT_LEVEL);
		    l = D_CDR(l);
		}
		INDENT;
		printf("]\n");
	    }
	}
	else if (is_flat_tuple(t))
	{
	    printf("{");
	    for (i = 0; i < D_NARGS(t); i++)
	    {
		_p_co_print1_nonl(D_ARG(t, i));
		if (i < D_NARGS(t) - 1)
		{
		    printf(", ");
		}
	    }
	    printf("}\n");
	}
	else
	{
	    printf("{\n");
	    for (i = 0; i < D_NARGS(t); i++)
	    {
		_p_co_print1(D_ARG(t, i), indent + INDENT_LEVEL);
	    }
	    INDENT;
	    printf("}\n");
	}
	break;

    case D_LIST:
	printf("List. Head:\n");
	_p_co_print1(D_LHEAD(t), indent + INDENT_LEVEL);
	/*
	INDENT;
	printf("      Tail:\n");
	_p_co_print1(*(D_LTAIL(t)), indent + INDENT_LEVEL);
	*/
	break;

    case D_NIL:
	printf("[]\n");
	break;

    default:
	printf("ERROR: unknown type %d in _p_co_print\n",
	       D_TYPE(t));
    }
}


void 
_p_co_print(t)  datum *t;
{
    _p_co_print1(t, 0);
}

void 
_p_co_debug(t)  datum *t;
{
    _p_co_print(t);
}

void 
_p_co_free(t)  datum *t;
{
}

void 
_p_co_parse_cpp_directive(line)
char *line;
{
    char *s;
    char *lstart;

    s = line;
    while (*s == '#' || *s == ' ' || *s == '\t')
	s++;

    lstart = s;
    while (*s >= '0' && *s <= '9')
	s++;
    *s++ = '\0';

    _p_co_lineno = atoi(lstart);

    while (*s == ' ' || *s == '\t')
	s++;

    if (*s++ != '"')
    {
	return;
    }

    lstart = s;

    while (*s != '"')
	s++;
    *s = '\0';

    strcpy(_p_co_filename, lstart);
}

    

These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.