/[gcl]/gcl/o/typespec.c
ViewVC logotype

Diff of /gcl/o/typespec.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1.1.1 by wfs, Mon Dec 6 22:44:13 1999 UTC revision 1.2 by camm, Sat Jul 20 07:10:56 2002 UTC
# Line 34  Foundation, 675 Mass Ave, Cambridge, MA Line 34  Foundation, 675 Mass Ave, Cambridge, MA
34  object sLkeyword;  object sLkeyword;
35    
36    
37  check_type_integer(p)  void
38  object *p;  check_type_integer(object *p)
39  {  {
40          enum type t;          enum type t;
41    
# Line 43  object *p; Line 43  object *p;
43                  *p = wrong_type_argument(sLinteger, *p);                  *p = wrong_type_argument(sLinteger, *p);
44  }  }
45    
46  check_type_non_negative_integer(p)  void
47  object *p;  check_type_non_negative_integer(object *p)
48  {  {
49          enum type t;          enum type t;
50    
# Line 61  object *p; Line 61  object *p;
61          }          }
62  }  }
63    
64  check_type_rational(p)  void
65  object *p;  check_type_rational(object *p)
66  {  {
67          enum type t;          enum type t;
68    
# Line 71  object *p; Line 71  object *p;
71                  *p = wrong_type_argument(sLrational, *p);                  *p = wrong_type_argument(sLrational, *p);
72  }  }
73    
74  check_type_float(p)  void
75  object *p;  check_type_float(object *p)
76  {  {
77          enum type t;          enum type t;
78    
# Line 80  object *p; Line 80  object *p;
80                  *p = wrong_type_argument(sLfloat, *p);                  *p = wrong_type_argument(sLfloat, *p);
81  }  }
82    
83  check_type_or_integer_float(p)  void
84  object *p;  check_type_or_integer_float(object *p)
85  {  {
86          enum type t;          enum type t;
87    
# Line 90  object *p; Line 90  object *p;
90                  *p = wrong_type_argument(TSor_integer_float, *p);                  *p = wrong_type_argument(TSor_integer_float, *p);
91  }  }
92    
93  check_type_or_rational_float(p)  void
94  object *p;  check_type_or_rational_float(object *p)
95  {  {
96          enum type t;          enum type t;
97    
# Line 100  object *p; Line 100  object *p;
100                  *p = wrong_type_argument(TSor_rational_float, *p);                  *p = wrong_type_argument(TSor_rational_float, *p);
101  }  }
102    
103  check_type_number(p)  void
104  object *p;  check_type_number(object *p)
105  {  {
106          enum type t;          enum type t;
107    
# Line 111  object *p; Line 111  object *p;
111                  *p = wrong_type_argument(sLnumber, *p);                  *p = wrong_type_argument(sLnumber, *p);
112  }  }
113    
114  check_type_bit(p)  void
115  object *p;  check_type_bit(object *p)
116  {  {
117          while (type_of(*p) != t_fixnum ||          while (type_of(*p) != t_fixnum ||
118                 fix((*p)) != 0 && fix((*p)) != 1)                 (fix((*p)) != 0 && fix((*p)) != 1))
119                  *p = wrong_type_argument(sLbit, *p);                  *p = wrong_type_argument(sLbit, *p);
120  }  }
121    
122  check_type_character(p)  void
123  object *p;  check_type_character(object *p)
124  {  {
125          while (type_of(*p) != t_character)          while (type_of(*p) != t_character)
126                  *p = wrong_type_argument(sLcharacter, *p);                  *p = wrong_type_argument(sLcharacter, *p);
127  }  }
128    
129  check_type_string_char(p)  void
130  object *p;  check_type_string_char(object *p)
131  {  {
132          while (type_of(*p) != t_character ||          while (type_of(*p) != t_character ||
133                 char_font((*p)) != 0 ||                 char_font((*p)) != 0 ||
# Line 135  object *p; Line 135  object *p;
135                  *p = wrong_type_argument(sLcharacter, *p);                  *p = wrong_type_argument(sLcharacter, *p);
136  }  }
137    
138  check_type_symbol(p)  void
139  object *p;  check_type_symbol(object *p)
140  {  {
141          while (type_of(*p) != t_symbol)          while (type_of(*p) != t_symbol)
142                  *p = wrong_type_argument(sLsymbol, *p);                  *p = wrong_type_argument(sLsymbol, *p);
143  }  }
144    
145  check_type_or_symbol_string(p)  void
146  object *p;  check_type_or_symbol_string(object *p)
147  {  {
148          while (type_of(*p) != t_symbol && type_of(*p) != t_string)          while (type_of(*p) != t_symbol && type_of(*p) != t_string)
149                  *p = wrong_type_argument(TSor_symbol_string, *p);                  *p = wrong_type_argument(TSor_symbol_string, *p);
150  }  }
151    
152  check_type_or_string_symbol(p)  void
153  object *p;  check_type_or_string_symbol(object *p)
154  {  {
155          while (type_of(*p) != t_symbol && type_of(*p) != t_string)          while (type_of(*p) != t_symbol && type_of(*p) != t_string)
156                  *p = wrong_type_argument(TSor_string_symbol, *p);                  *p = wrong_type_argument(TSor_string_symbol, *p);
157  }  }
158    
159  check_type_or_symbol_string_package(p)  void
160  object *p;  check_type_or_symbol_string_package(object *p)
161  {  {
162          while (type_of(*p) != t_symbol &&          while (type_of(*p) != t_symbol &&
163                 type_of(*p) != t_string &&                 type_of(*p) != t_string &&
# Line 166  object *p; Line 166  object *p;
166                                             *p);                                             *p);
167  }  }
168    
169  check_type_package(p)  void
170  object *p;  check_type_package(object *p)
171  {  {
172          while (type_of(*p) != t_package)          while (type_of(*p) != t_package)
173                  *p = wrong_type_argument(sLpackage, *p);                  *p = wrong_type_argument(sLpackage, *p);
174  }  }
175    
176  check_type_string(p)  void
177  object *p;  check_type_string(object *p)
178  {  {
179          while (type_of(*p) != t_string)          while (type_of(*p) != t_string)
180                  *p = wrong_type_argument(sLstring, *p);                  *p = wrong_type_argument(sLstring, *p);
181  }  }
182    
183  check_type_bit_vector(p)  void
184  object *p;  check_type_bit_vector(object *p)
185  {  {
186          while (type_of(*p) != t_bitvector)          while (type_of(*p) != t_bitvector)
187                  *p = wrong_type_argument(sLbit_vector, *p);                  *p = wrong_type_argument(sLbit_vector, *p);
188  }  }
189    
190  check_type_cons(p)  void
191  object *p;  check_type_cons(object *p)
192  {  {
193          while (type_of(*p) != t_cons)          while (type_of(*p) != t_cons)
194                  *p = wrong_type_argument(sLcons, *p);                  *p = wrong_type_argument(sLcons, *p);
195  }  }
196    
197  check_type_stream(p)  void
198  object *p;  check_type_stream(object *p)
199  {  {
200          while (type_of(*p) != t_stream)          while (type_of(*p) != t_stream)
201                  *p = wrong_type_argument(sLstream, *p);                  *p = wrong_type_argument(sLstream, *p);
202  }  }
203    
204  check_type_readtable(p)  void
205  object *p;  check_type_readtable(object *p)
206  {  {
207          while (type_of(*p) != t_readtable)          while (type_of(*p) != t_readtable)
208                  *p = wrong_type_argument(sLreadtable, *p);                  *p = wrong_type_argument(sLreadtable, *p);
209  }  }
210    
211  #ifdef UNIX  #ifdef UNIX
212  check_type_or_Pathname_string_symbol(p)  void
213  object *p;  check_type_or_Pathname_string_symbol(object *p)
214  {  {
215          enum type t;          enum type t;
216    
# Line 221  object *p; Line 221  object *p;
221  }  }
222  #endif  #endif
223    
224  check_type_or_pathname_string_symbol_stream(p)  void
225  object *p;  check_type_or_pathname_string_symbol_stream(object *p)
226  {  {
227          enum type t;          enum type t;
228    
# Line 232  object *p; Line 232  object *p;
232                          TSor_pathname_string_symbol_stream, *p);                          TSor_pathname_string_symbol_stream, *p);
233  }  }
234    
235  check_type_random_state(p)  void
236  object *p;  check_type_random_state(object *p)
237  {  {
238          while (type_of(*p) != t_random)          while (type_of(*p) != t_random)
239                  *p = wrong_type_argument(sLrandom_state, *p);                  *p = wrong_type_argument(sLrandom_state, *p);
240  }  }
241    
242  check_type_hash_table(p)  void
243  object *p;  check_type_hash_table(object *p)
244  {  {
245          while (type_of(*p) != t_hashtable)          while (type_of(*p) != t_hashtable)
246                  *p = wrong_type_argument(sLhash_table, *p);                  *p = wrong_type_argument(sLhash_table, *p);
247  }  }
248    
249  check_type_array(p)  void
250  object *p;  check_type_array(object *p)
251  {  {
252  BEGIN:  BEGIN:
253          switch (type_of(*p)) {          switch (type_of(*p)) {
# Line 263  BEGIN: Line 263  BEGIN:
263          }          }
264  }  }
265    
266  check_type_vector(p)  void
267  object *p;  check_type_vector(object *p)
268  {  {
269  BEGIN:  BEGIN:
270          switch (type_of(*p)) {          switch (type_of(*p)) {
# Line 280  BEGIN: Line 280  BEGIN:
280  }  }
281    
282  void  void
283  check_type(x,t)  check_type(object x, int t)
      object x;  
      int t;  
284  {if (type_of(x) !=t)  {if (type_of(x) !=t)
285     FEerror("~s is not a ~a",2,     FEerror("~s is not a ~a",2,
286             x,make_simple_string(tm_table[t].tm_name +1));             x,make_simple_string(tm_table[t].tm_name +1));
287  }  }
288        
289    
290    void
291  Ltype_of()  Ltype_of(void)
292  {  {
293          int i;          int i;
294    
# Line 327  Ltype_of() Line 325  Ltype_of()
325                          vs_base[0] = sLcharacter;                          vs_base[0] = sLcharacter;
326                  else {                  else {
327                          i = char_code(vs_base[0]);                          i = char_code(vs_base[0]);
328                          if (' ' <= i && i < '\177' || i == '\n')                          if ((' ' <= i && i < '\177') || i == '\n')
329                                  vs_base[0] = sLstandard_char;                                  vs_base[0] = sLstandard_char;
330                          else                          else
331                                  vs_base[0] = sLstring_char;                                  vs_base[0] = sLstring_char;
# Line 488  DEF_ORDINARY("PLUSP",sLplusp,LISP,""); Line 486  DEF_ORDINARY("PLUSP",sLplusp,LISP,"");
486  DEFCONST("CHAR-SIZE",sSchar_size,SI,small_fixnum(CHAR_SIZE),"Size in bits of a character");  DEFCONST("CHAR-SIZE",sSchar_size,SI,small_fixnum(CHAR_SIZE),"Size in bits of a character");
487  DEFCONST("SHORT-SIZE",sSshort_size,SI,small_fixnum(CHAR_SIZE*sizeof(short)),"Size in bits of a short integer");  DEFCONST("SHORT-SIZE",sSshort_size,SI,small_fixnum(CHAR_SIZE*sizeof(short)),"Size in bits of a short integer");
488    
489        void    
490  init_typespec()  init_typespec(void)
491  {  {
492  }  }
493    
494  init_typespec_function()  void
495    init_typespec_function(void)
496  {  {
497          TSor_symbol_string          TSor_symbol_string
498          = make_cons(sLor, make_cons(sLsymbol, make_cons(sLstring, Cnil)));          = make_cons(sLor, make_cons(sLsymbol, make_cons(sLstring, Cnil)));

Legend:
Removed from v.1.1.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26