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.