← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to src/c/mapfun.d

  • Committer: Bazaar Package Importer
  • Author(s): Albin Tonnerre
  • Date: 2008-06-20 18:00:19 UTC
  • mfrom: (1.1.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20080620180019-7fbz1ln5444vtkkr
Tags: 0.9j-20080306-2ubuntu1
* Enabled unicode support. (Closes: LP #123530)
* Modify Maintainer value to match the DebianMaintainerField specification.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/c/mapfun.d
 
1
/* -*- mode: c; c-basic-offset: 8 -*- */
1
2
/*
2
3
    mapfun.c -- Mapping.
3
4
*/
15
16
 
16
17
 
17
18
#include <ecl/ecl.h>
 
19
#include <ecl/internal.h>
18
20
 
19
 
static cl_index
20
 
prepare_map(cl_va_list lists, cl_index *cdrs_sp)
 
21
static void
 
22
prepare_map(cl_va_list lists, cl_object cdrs_frame, cl_object cars_frame)
21
23
{
22
 
        cl_index i, nlist = lists[0].narg;
23
 
 
24
 
        *cdrs_sp = cl_stack_index();
25
 
        if (nlist == 0)
 
24
        cl_index i;
 
25
        ecl_stack_frame_push_va_list(cdrs_frame, lists);
 
26
        if (cdrs_frame->frame.narg == 0) {
26
27
                FEprogram_error("MAP*: Too few arguments.", 0);
27
 
        cl_stack_push_va_list(lists);
28
 
        for (i = 0; i<nlist; i++)
29
 
                cl_stack_push(Cnil);
30
 
        return nlist;
 
28
        }
 
29
        ecl_stack_frame_reserve(cars_frame, cdrs_frame->frame.narg);
 
30
        for (i = 0; i < cars_frame->frame.narg; i++) {
 
31
                ecl_stack_frame_elt_set(cars_frame, i, Cnil);
 
32
        }
31
33
}
32
34
 
33
35
@(defun mapcar (fun &rest lists)
34
36
        cl_object res, *val = &res;
35
 
        cl_index i, nlist, cdrs_sp;
36
 
@
37
 
        nlist = prepare_map(lists, &cdrs_sp);
 
37
        cl_index i;
 
38
@ {
 
39
        ECL_BUILD_STACK_FRAME(cars_frame);
 
40
        ECL_BUILD_STACK_FRAME(cdrs_frame);
 
41
        prepare_map(lists, cdrs_frame, cars_frame);
38
42
        res = Cnil;
39
43
        while (TRUE) {
40
 
                /* INV: The stack does not grow here. */
41
 
                cl_object *cdrs = cl_env.stack + cdrs_sp;
42
 
                cl_object *cars = cdrs + nlist;
43
 
                for (i = 0;  i < nlist;  i++) {
44
 
                        if (ecl_endp(cdrs[i])) {
45
 
                                cl_stack_set_index(cdrs_sp);
 
44
                cl_index i;
 
45
                for (i = 0;  i < cdrs_frame->frame.narg;  i++) {
 
46
                        cl_object cdr = ecl_stack_frame_elt(cdrs_frame, i);
 
47
                        if (ecl_endp(cdr)) {
 
48
                                ecl_stack_frame_close(cars_frame);
 
49
                                ecl_stack_frame_close(cdrs_frame);
46
50
                                @(return res)
47
51
                        }
48
 
                        cars[i] = CAR(cdrs[i]);
49
 
                        cdrs[i] = CDR(cdrs[i]);
 
52
                        ecl_stack_frame_elt_set(cars_frame, i, CAR(cdr));
 
53
                        ecl_stack_frame_elt_set(cdrs_frame, i, CDR(cdr));
50
54
                }
51
 
                *val = CONS(cl_apply_from_stack(nlist, fun), Cnil);
 
55
                *val = CONS(ecl_apply_from_stack_frame(cars_frame, fun), Cnil);
52
56
                val = &CDR(*val);
53
57
        }
54
 
@)
 
58
} @)
55
59
 
56
60
@(defun maplist (fun &rest lists)
57
61
        cl_object res, *val = &res;
58
 
        cl_index i, nlist, cdrs_sp;
59
 
@
60
 
        nlist = prepare_map(lists, &cdrs_sp);
 
62
@ {
 
63
        ECL_BUILD_STACK_FRAME(cars_frame);
 
64
        ECL_BUILD_STACK_FRAME(cdrs_frame);
 
65
        prepare_map(lists, cdrs_frame, cars_frame);
61
66
        res = Cnil;
62
67
        while (TRUE) {
63
 
                cl_object *cdrs = cl_env.stack + cdrs_sp;
64
 
                cl_object *cars = cdrs + nlist;
65
 
                for (i = 0;  i < nlist;  i++) {
66
 
                        if (ecl_endp(cdrs[i])) {
67
 
                                cl_stack_set_index(cdrs_sp);
 
68
                cl_index i;
 
69
                for (i = 0;  i < cdrs_frame->frame.narg;  i++) {
 
70
                        cl_object cdr = ecl_stack_frame_elt(cdrs_frame, i);
 
71
                        if (ecl_endp(cdr)) {
 
72
                                ecl_stack_frame_close(cars_frame);
 
73
                                ecl_stack_frame_close(cdrs_frame);
68
74
                                @(return res)
69
75
                        }
70
 
                        cars[i] = cdrs[i];
71
 
                        cdrs[i] = CDR(cdrs[i]);
 
76
                        ecl_stack_frame_elt_set(cars_frame, i, cdr);
 
77
                        ecl_stack_frame_elt_set(cdrs_frame, i, CDR(cdr));
72
78
                }
73
 
                *val = CONS(cl_apply_from_stack(nlist, fun), Cnil);
 
79
                *val = CONS(ecl_apply_from_stack_frame(cars_frame, fun), Cnil);
74
80
                val = &CDR(*val);
75
81
        }
76
 
@)
 
82
} @)
77
83
 
78
84
@(defun mapc (fun &rest lists)
79
85
        cl_object onelist;
80
 
        cl_index i, nlist, cdrs_sp;
81
 
@
82
 
        nlist = prepare_map(lists, &cdrs_sp);
83
 
        onelist = cl_env.stack[cdrs_sp];
 
86
@ {
 
87
        ECL_BUILD_STACK_FRAME(cars_frame);
 
88
        ECL_BUILD_STACK_FRAME(cdrs_frame);
 
89
        prepare_map(lists, cdrs_frame, cars_frame);
 
90
        onelist = ecl_stack_frame_elt(cdrs_frame, 0);
84
91
        while (TRUE) {
85
 
                cl_object *cdrs = cl_env.stack + cdrs_sp;
86
 
                cl_object *cars = cdrs + nlist;
87
 
                for (i = 0;  i < nlist;  i++) {
88
 
                        if (ecl_endp(cdrs[i])) {
89
 
                                cl_stack_set_index(cdrs_sp);
 
92
                cl_index i;
 
93
                for (i = 0;  i < cdrs_frame->frame.narg;  i++) {
 
94
                        cl_object cdr = ecl_stack_frame_elt(cdrs_frame, i);
 
95
                        if (ecl_endp(cdr)) {
 
96
                                ecl_stack_frame_close(cars_frame);
 
97
                                ecl_stack_frame_close(cdrs_frame);
90
98
                                @(return onelist)
91
99
                        }
92
 
                        cars[i] = CAR(cdrs[i]);
93
 
                        cdrs[i] = CDR(cdrs[i]);
 
100
                        ecl_stack_frame_elt_set(cars_frame, i, CAR(cdr));
 
101
                        ecl_stack_frame_elt_set(cdrs_frame, i, CDR(cdr));
94
102
                }
95
 
                cl_apply_from_stack(nlist, fun);
 
103
                ecl_apply_from_stack_frame(cars_frame, fun);
96
104
        }
97
 
@)
 
105
} @)
98
106
 
99
107
@(defun mapl (fun &rest lists)
100
108
        cl_object onelist;
101
 
        cl_index i, nlist, cdrs_sp;
102
 
@
103
 
        nlist = prepare_map(lists, &cdrs_sp);
104
 
        onelist = cl_env.stack[cdrs_sp];
 
109
@ {
 
110
        ECL_BUILD_STACK_FRAME(cars_frame);
 
111
        ECL_BUILD_STACK_FRAME(cdrs_frame);
 
112
        prepare_map(lists, cdrs_frame, cars_frame);
 
113
        onelist = ecl_stack_frame_elt(cdrs_frame, 0);
105
114
        while (TRUE) {
106
 
                cl_object *cdrs = cl_env.stack + cdrs_sp;
107
 
                cl_object *cars = cdrs + nlist;
108
 
                for (i = 0;  i < nlist;  i++) {
109
 
                        if (ecl_endp(cdrs[i])) {
110
 
                                cl_stack_set_index(cdrs_sp);
 
115
                cl_index i;
 
116
                for (i = 0;  i < cdrs_frame->frame.narg;  i++) {
 
117
                        cl_object cdr = ecl_stack_frame_elt(cdrs_frame, i);
 
118
                        if (ecl_endp(cdr)) {
 
119
                                ecl_stack_frame_close(cars_frame);
 
120
                                ecl_stack_frame_close(cdrs_frame);
111
121
                                @(return onelist)
112
122
                        }
113
 
                        cars[i] = cdrs[i];
114
 
                        cdrs[i] = CDR(cdrs[i]);
 
123
                        ecl_stack_frame_elt_set(cars_frame, i, cdr);
 
124
                        ecl_stack_frame_elt_set(cdrs_frame, i, CDR(cdr));
115
125
                }
116
 
                cl_apply_from_stack(nlist, fun);
 
126
                ecl_apply_from_stack_frame(cars_frame, fun);
117
127
        }
118
 
@)
 
128
} @)
119
129
 
120
130
@(defun mapcan (fun &rest lists)
121
131
        cl_object res, *val = &res;
122
 
        cl_index i, nlist, cdrs_sp;
123
 
@
124
 
        nlist = prepare_map(lists, &cdrs_sp);
 
132
@ {
 
133
        ECL_BUILD_STACK_FRAME(cars_frame);
 
134
        ECL_BUILD_STACK_FRAME(cdrs_frame);
 
135
        prepare_map(lists, cdrs_frame, cars_frame);
125
136
        res = Cnil;
126
137
        while (TRUE) {
127
 
                cl_object *cdrs = cl_env.stack + cdrs_sp;
128
 
                cl_object *cars = cdrs + nlist;
129
 
                for (i = 0;  i < nlist;  i++) {
130
 
                        if (ecl_endp(cdrs[i])) {
131
 
                                cl_stack_set_index(cdrs_sp);
 
138
                cl_index i;
 
139
                for (i = 0;  i < cdrs_frame->frame.narg;  i++) {
 
140
                        cl_object cdr = ecl_stack_frame_elt(cdrs_frame, i);
 
141
                        if (ecl_endp(cdr)) {
 
142
                                ecl_stack_frame_close(cars_frame);
 
143
                                ecl_stack_frame_close(cdrs_frame);
132
144
                                @(return res)
133
145
                        }
134
 
                        cars[i] = CAR(cdrs[i]);
135
 
                        cdrs[i] = CDR(cdrs[i]);
 
146
                        ecl_stack_frame_elt_set(cars_frame, i, CAR(cdr));
 
147
                        ecl_stack_frame_elt_set(cdrs_frame, i, CDR(cdr));
136
148
                }
137
 
                *val = cl_apply_from_stack(nlist, fun);
 
149
                *val = ecl_apply_from_stack_frame(cars_frame, fun);
138
150
                while (CONSP(*val))
139
151
                        val = &CDR(*val);
140
152
        }
141
 
@)
 
153
} @)
142
154
 
143
155
@(defun mapcon (fun &rest lists)
144
156
        cl_object res, *val = &res;
145
 
        cl_index i, nlist, cdrs_sp;
146
 
@
147
 
        nlist = prepare_map(lists, &cdrs_sp);
 
157
@ {
 
158
        ECL_BUILD_STACK_FRAME(cars_frame);
 
159
        ECL_BUILD_STACK_FRAME(cdrs_frame);
 
160
        prepare_map(lists, cdrs_frame, cars_frame);
148
161
        res = Cnil;
149
162
        while (TRUE) {
150
 
                cl_object *cdrs = cl_env.stack + cdrs_sp;
151
 
                cl_object *cars = cdrs + nlist;
152
 
                for (i = 0;  i < nlist;  i++) {
153
 
                        if (ecl_endp(cdrs[i])) {
154
 
                                cl_stack_set_index(cdrs_sp);
 
163
                cl_index i;
 
164
                for (i = 0;  i < cdrs_frame->frame.narg;  i++) {
 
165
                        cl_object cdr = ecl_stack_frame_elt(cdrs_frame, i);
 
166
                        if (ecl_endp(cdr)) {
 
167
                                ecl_stack_frame_close(cars_frame);
 
168
                                ecl_stack_frame_close(cdrs_frame);
155
169
                                @(return res)
156
170
                        }
157
 
                        cars[i] = cdrs[i];
158
 
                        cdrs[i] = CDR(cdrs[i]);
 
171
                        ecl_stack_frame_elt_set(cars_frame, i, cdr);
 
172
                        ecl_stack_frame_elt_set(cdrs_frame, i, CDR(cdr));
159
173
                }
160
 
                *val = cl_apply_from_stack(nlist, fun);
 
174
                *val = ecl_apply_from_stack_frame(cars_frame, fun);
161
175
                while (CONSP(*val))
162
176
                        val = &CDR(*val);
163
177
        }
164
 
@)
 
178
} @)