← Back to branch summary

~ubuntu-branches/ubuntu/vivid/gcl/vivid

« back to all changes in this revision

Viewing changes to o/conditional.c

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2002-03-04 14:29:59 UTC
  • Revision ID: james.westby@ubuntu.com-20020304142959-dey14w08kr7lldu3
Tags: upstream-2.5.0.cvs20020219
Import upstream version 2.5.0.cvs20020219

Show diffs side-by-side

added added

removed removed

Lines of Context:
o/conditional.c
 
1
/*
 
2
 Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
 
3
 
 
4
This file is part of GNU Common Lisp, herein referred to as GCL
 
5
 
 
6
GCL is free software; you can redistribute it and/or modify it under
 
7
the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
 
8
the Free Software Foundation; either version 2, or (at your option)
 
9
any later version.
 
10
 
 
11
GCL is distributed in the hope that it will be useful, but WITHOUT
 
12
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 
13
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public 
 
14
License for more details.
 
15
 
 
16
You should have received a copy of the GNU Library General Public License 
 
17
along with GCL; see the file COPYING.  If not, write to the Free Software
 
18
Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
19
 
 
20
*/
 
21
 
 
22
/*
 
23
 
 
24
        conditional.c
 
25
 
 
26
        conditionals
 
27
*/
 
28
 
 
29
#include "include.h"
 
30
 
 
31
object sLotherwise;
 
32
 
 
33
Fif(form)
 
34
object form;
 
35
{
 
36
        object endp_temp;
 
37
 
 
38
        object *top = vs_top;
 
39
 
 
40
        if (endp(form) || endp(MMcdr(form)))
 
41
                FEtoo_few_argumentsF(form);
 
42
        if (!endp(MMcddr(form)) && !endp(MMcdddr(form)))
 
43
                FEtoo_many_argumentsF(form);
 
44
        eval(MMcar(form));
 
45
        if (vs_base[0] == Cnil)
 
46
                if (endp(MMcddr(form))) {
 
47
                        vs_top = vs_base = top;
 
48
                        vs_push(Cnil);
 
49
                } else {
 
50
                        vs_top = top;
 
51
                        eval(MMcaddr(form));
 
52
                }
 
53
        else {
 
54
                vs_top = top;
 
55
                eval(MMcadr(form));
 
56
        }
 
57
}
 
58
 
 
59
Fcond(args)
 
60
object args;
 
61
{
 
62
        object endp_temp;
 
63
 
 
64
        object *top = vs_top;
 
65
        object clause;
 
66
        object conseq;
 
67
 
 
68
        while (!endp(args)) {
 
69
                clause = MMcar(args);
 
70
                if (type_of(clause) != t_cons)
 
71
                        FEerror("~S is an illegal COND clause.",1,clause);
 
72
                eval(MMcar(clause));
 
73
                if (vs_base[0] != Cnil) {
 
74
                        conseq = MMcdr(clause);
 
75
                        if (endp(conseq)) {
 
76
                                vs_top = vs_base+1;
 
77
                                return;
 
78
                        }
 
79
                        while (!endp(conseq)) {
 
80
                                vs_top = top;
 
81
                                eval(MMcar(conseq));
 
82
                                conseq = MMcdr(conseq);
 
83
                        }
 
84
                        return;
 
85
                }
 
86
                vs_top = top;
 
87
                args = MMcdr(args);
 
88
        }
 
89
        vs_base = vs_top = top;
 
90
        vs_push(Cnil);
 
91
}
 
92
 
 
93
Fcase(arg)
 
94
object arg;
 
95
{
 
96
        object endp_temp;
 
97
 
 
98
        object *top = vs_top;
 
99
        object clause;
 
100
        object key;
 
101
        object conseq;
 
102
 
 
103
        if (endp(arg))
 
104
                FEtoo_few_argumentsF(arg);
 
105
        eval(MMcar(arg));
 
106
        vs_top = top;
 
107
        vs_push(vs_base[0]);
 
108
        arg = MMcdr(arg);
 
109
        while (!endp(arg)) {
 
110
                clause = MMcar(arg);
 
111
                if (type_of(clause) != t_cons)
 
112
                        FEerror("~S is an illegal CASE clause.",1,clause);
 
113
                key = MMcar(clause);
 
114
                conseq = MMcdr(clause);
 
115
                if (type_of(key) == t_cons)
 
116
                        do {
 
117
                                if (eql(MMcar(key),top[0]))
 
118
                                        goto FOUND;
 
119
                                key = MMcdr(key);
 
120
                        } while (!endp(key));
 
121
                else if (key == Cnil)
 
122
                        ;
 
123
                else if (key == Ct || key == sLotherwise || eql(key,top[0]))
 
124
                        goto FOUND;
 
125
                arg = MMcdr(arg);
 
126
        }
 
127
        vs_base = vs_top = top;
 
128
        vs_push(Cnil);
 
129
        return;
 
130
 
 
131
FOUND:
 
132
        if (endp(conseq)) {
 
133
                vs_base = vs_top = top;
 
134
                vs_push(Cnil);
 
135
        } else
 
136
                 do {
 
137
                        vs_top = top;
 
138
                        eval(MMcar(conseq));
 
139
                        conseq = MMcdr(conseq);
 
140
                } while (!endp(conseq));
 
141
        return;
 
142
}
 
143
 
 
144
Fwhen(form)
 
145
object form;
 
146
{
 
147
        object endp_temp;
 
148
 
 
149
        object *top = vs_top;
 
150
 
 
151
        if (endp(form))
 
152
                FEtoo_few_argumentsF(form);
 
153
        eval(MMcar(form));
 
154
        if (vs_base[0] == Cnil) {
 
155
                vs_base = vs_top = top;
 
156
                vs_push(Cnil);
 
157
        } else {
 
158
                form = MMcdr(form);
 
159
                if (endp(form)) {
 
160
                        vs_base = vs_top = top;
 
161
                        vs_push(Cnil);
 
162
                } else
 
163
                        do {
 
164
                                vs_top = top;
 
165
                                eval(MMcar(form));
 
166
                                form = MMcdr(form);
 
167
                        } while (!endp(form));
 
168
        }
 
169
}
 
170
 
 
171
Funless(form)
 
172
object form;
 
173
{
 
174
        object endp_temp;
 
175
 
 
176
        object *top = vs_top;
 
177
 
 
178
        if (endp(form))
 
179
                FEtoo_few_argumentsF(form);
 
180
        eval(MMcar(form));
 
181
        if (vs_base[0] == Cnil) {
 
182
                vs_top = top;
 
183
                form = MMcdr(form);
 
184
                if (endp(form)) {
 
185
                        vs_base = vs_top = top;
 
186
                        vs_push(Cnil);
 
187
                } else
 
188
                        do {
 
189
                                vs_top = top;
 
190
                                eval(MMcar(form));
 
191
                                form = MMcdr(form);
 
192
                        } while (!endp(form));
 
193
        } else {
 
194
                vs_base = vs_top = top;
 
195
                vs_push(Cnil);
 
196
        }
 
197
}
 
198
 
 
199
init_conditional()
 
200
{
 
201
        make_special_form("IF",Fif);
 
202
        make_special_form("COND",Fcond);
 
203
        make_special_form("CASE",Fcase);
 
204
        make_special_form("WHEN",Fwhen);
 
205
        make_special_form("UNLESS",Funless);
 
206
 
 
207
        sLotherwise = make_ordinary("OTHERWISE");
 
208
        enter_mark_origin(&sLotherwise);
 
209
}