fixed bug in 'str[r]chr' family
[k8-xscheme:k8-xscheme.git] / src / core / 2port.c
1 /* xpairlis - built-in function 'pairlis' */
2 xlValue xpairlis (void) {
3   xlValue keys, data;
4   keys = xlGetArgList();
5   data = xlGetArgList();
6   xlVal = xlMoreArgsP() ? xlGetArgList() : xlNil;
7   xlCheck(2);
8   xlPush(keys);
9   xlPush(data);
10   while (xlConsP(keys) && xlConsP(data)) {
11     xlVal = xlCons(xlCons(xlCar(keys), xlCar(data)), xlVal);
12     keys = xlCdr(keys);
13     data = xlCdr(data);
14   }
15   xlDrop(2);
16   return xlVal;
17 }
18
19
20 /* xcopylist - built-in function 'copy-list' */
21 xlValue xcopylist (void) {
22   xlValue last;
23   xlVal = xlGetArgList();
24   xlLastArg();
25   xlCPush(xlNil);
26   if (xlVal) {
27     last = xlCons(xlCar(xlVal), xlNil); xlSetTop(last);
28     for (xlVal = xlCdr(xlVal); xlConsP(xlVal); xlVal = xlCdr(xlVal)) {
29       xlSetCdr(last, xlCons(xlCar(xlVal), xlNil));
30       last = xlCdr(last);
31     }
32   }
33   return xlPop();
34 }
35
36
37 /* copytree - copytree helper function */
38 static xlValue copytree (xlValue tree) {
39   if (xlConsP(tree)) {
40     xlCPush(copytree(xlCar(tree)));
41     tree = copytree(xlCdr(tree));
42     tree = xlCons(xlPop(), tree);
43   }
44   return tree;
45 }
46
47
48 /* xcopytree - built-in function 'copy-tree' */
49 xlValue xcopytree (void) {
50   xlVal = xlGetArgList();
51   xlLastArg();
52   return copytree(xlVal);
53 }
54
55
56 /* xcopyalist - built-in function 'copy-alist' */
57 xlValue xcopyalist (void) {
58   xlValue last, entry;
59   xlVal = xlGetArgList();
60   xlLastArg();
61   xlCPush(xlNil);
62   if (xlVal) {
63     entry = xlCar(xlVal);
64     if (xlConsP(entry)) entry = xlCons(xlCar(entry), xlCdr(entry));
65     last = xlCons(entry, xlNil); xlSetTop(last);
66     for (xlVal = xlCdr(xlVal); xlConsP(xlVal); xlVal = xlCdr(xlVal)) {
67       entry = xlCar(xlVal);
68       if (xlConsP(entry)) entry = xlCons(xlCar(entry), xlCdr(entry));
69       xlSetCdr(last, xlCons(entry, xlNil));
70       last = xlCdr(last);
71     }
72   }
73   return xlPop();
74 }