Annotation of OpenXM_contrib2/asir2000/builtin/list.c, Revision 1.1.1.1
1.1 noro 1: /* $OpenXM: OpenXM/src/asir99/builtin/list.c,v 1.1.1.1 1999/11/10 08:12:25 noro Exp $ */
2: #include "ca.h"
3: #include "parse.h"
4:
5: void Pcar(), Pcdr(), Pcons(), Pappend(), Preverse(), Plength();
6:
7: struct ftab list_tab[] = {
8: {"car",Pcar,1},
9: {"cdr",Pcdr,1},
10: {"cons",Pcons,2},
11: {"append",Pappend,2},
12: {"reverse",Preverse,1},
13: {"length",Plength,1},
14: {0,0,0},
15: };
16:
17: void Pcar(arg,rp)
18: NODE arg;
19: pointer *rp;
20: {
21: asir_assert(ARG0(arg),O_LIST,"car");
22: if ( !BDY((LIST)ARG0(arg)) )
23: *rp = ARG0(arg);
24: else
25: *rp = (pointer)BDY(BDY((LIST)ARG0(arg)));
26: }
27:
28: void Pcdr(arg,rp)
29: NODE arg;
30: LIST *rp;
31: {
32: asir_assert(ARG0(arg),O_LIST,"cdr");
33: if ( !BDY((LIST)ARG0(arg)) )
34: *rp = (LIST)ARG0(arg);
35: else
36: MKLIST(*rp,NEXT(BDY((LIST)ARG0(arg))));
37: }
38:
39: void Pcons(arg,rp)
40: NODE arg;
41: LIST *rp;
42: {
43: NODE t;
44:
45: asir_assert(ARG1(arg),O_LIST,"cons");
46: MKNODE(t,ARG0(arg),BDY((LIST)ARG1(arg))); MKLIST(*rp,t);
47: }
48:
49: void Pappend(arg,rp)
50: NODE arg;
51: LIST *rp;
52: {
53: NODE t,t0,n;
54:
55: asir_assert(ARG0(arg),O_LIST,"append");
56: asir_assert(ARG1(arg),O_LIST,"append");
57: if ( !(n = BDY((LIST)ARG0(arg))) )
58: *rp = (LIST)ARG1(arg);
59: else {
60: for ( t0 = 0; n; n = NEXT(n) ) {
61: NEXTNODE(t0,t); BDY(t) = BDY(n);
62: }
63: NEXT(t) = BDY((LIST)ARG1(arg));
64: MKLIST(*rp,t0);
65: }
66: }
67:
68: void Preverse(arg,rp)
69: NODE arg;
70: LIST *rp;
71: {
72: NODE t,t1,n;
73:
74: asir_assert(ARG0(arg),O_LIST,"reverse");
75: if ( !(n = BDY((LIST)ARG0(arg))) )
76: *rp = (LIST)ARG0(arg);
77: else {
78: for ( t = 0; n; n = NEXT(n) ) {
79: MKNODE(t1,BDY(n),t); t = t1;
80: }
81: MKLIST(*rp,t);
82: }
83: }
84:
85: void Plength(arg,rp)
86: NODE arg;
87: Q *rp;
88: {
89: NODE n;
90: int i;
91:
92: asir_assert(ARG0(arg),O_LIST,"length");
93: n = BDY((LIST)ARG0(arg));
94: for ( i = 0; n; i++, n = NEXT(n) );
95: STOQ(i,*rp);
96: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>