/[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.16 by camm, Mon Aug 8 23:04:59 2005 UTC revision 1.17 by camm, Wed Sep 7 02:59:44 2005 UTC
# Line 291  check_type(object x, int t) Line 291  check_type(object x, int t)
291  }  }
292        
293    
294  LFD(Ltype_of)(void)  LFD(siLtype_of_c)(void)
295  {  {
296          int i;          int i;
297    
# Line 299  LFD(Ltype_of)(void) Line 299  LFD(Ltype_of)(void)
299    
300          switch (type_of(vs_base[0])) {          switch (type_of(vs_base[0])) {
301          case t_fixnum:          case t_fixnum:
302                  vs_base[0] = sLfixnum;            {
303                  break;              fixnum i=fix(vs_base[0]);
304                vs_base[0] = !i || i==1 ? sLbit : (i>0 ? sLnon_negative_fixnum : sLfixnum);
305              }
306              break;
307    
308          case t_bignum:          case t_bignum:
309                  vs_base[0] = sLbignum;            vs_base[0] = big_sign(vs_base[0])<0 ? sLbignum : sLnon_negative_bignum;
310                  break;            break;
311    
312          case t_ratio:          case t_ratio:
313                  vs_base[0] = sLratio;                  vs_base[0] = sLratio;
# Line 331  LFD(Ltype_of)(void) Line 334  LFD(Ltype_of)(void)
334                          if ((' ' <= i && i < '\177') || i == '\n')                          if ((' ' <= i && i < '\177') || i == '\n')
335                                  vs_base[0] = sLstandard_char;                                  vs_base[0] = sLstandard_char;
336                          else                          else
337                                  vs_base[0] = sLstring_char;                                  vs_base[0] = sLbase_char;
338                  }                  }
339                  break;                  break;
340    
341          case t_symbol:          case t_symbol:
342                  if (vs_base[0]->s.s_hpack == keyword_package)                  if (vs_base[0]==Cnil)
343                          vs_base[0] = sLkeyword;                    vs_base[0] = sLnull;
344                    else if (vs_base[0]==Ct)
345                      vs_base[0]=sLboolean;
346                    else if (vs_base[0]->s.s_hpack == keyword_package)
347                      vs_base[0] = sLkeyword;
348                  else                  else
349                          vs_base[0] = sLsymbol;                    vs_base[0] = sLsymbol;
350                  break;                  break;
351    
352          case t_package:          case t_package:
# Line 355  LFD(Ltype_of)(void) Line 362  LFD(Ltype_of)(void)
362                  break;                  break;
363    
364          case t_array:          case t_array:
365                  if (vs_base[0]->a.a_adjustable ||  /*              if (vs_base[0]->a.a_adjustable || */
366                      vs_base[0]->a.a_displaced->c.c_car == Cnil)  /*                  vs_base[0]->a.a_displaced->c.c_car == Cnil) */
367                          vs_base[0] = sLarray;  /*                      vs_base[0] = sLarray; */
368                  else  /*              else */
369                          vs_base[0] = sLsimple_array;            vs_base[0] = sLarray;
370                  break;            break;
371    
372          case t_vector:          case t_vector:
373                  if (vs_base[0]->v.v_adjustable ||  /*              if (vs_base[0]->v.v_adjustable || */
374                      vs_base[0]->v.v_hasfillp ||  /*                  vs_base[0]->v.v_hasfillp || */
375                      vs_base[0]->v.v_displaced->c.c_car == Cnil ||  /*                  vs_base[0]->v.v_displaced->c.c_car == Cnil || */
376                      (enum aelttype)vs_base[0]->v.v_elttype != aet_object)  /*                  (enum aelttype)vs_base[0]->v.v_elttype != aet_object) */
377                          vs_base[0] = sLvector;  /*                      vs_base[0] = sLvector; */
378                  else  /*              else */
379                          vs_base[0] = sLsimple_vector;            vs_base[0] = sLvector;
380                  break;            break;
381    
382          case t_string:          case t_string:
383                  if (vs_base[0]->st.st_adjustable ||  /*              if (vs_base[0]->st.st_adjustable || */
384                      vs_base[0]->st.st_hasfillp ||  /*                  vs_base[0]->st.st_hasfillp || */
385                      vs_base[0]->st.st_displaced->c.c_car == Cnil)  /*                  vs_base[0]->st.st_displaced->c.c_car == Cnil) */
386                          vs_base[0] = sLstring;  /*                      vs_base[0] = sLstring; */
387                  else  /*              else */
388                          vs_base[0] = sLsimple_string;            vs_base[0] = sLstring;
389                  break;            break;
390    
391          case t_bitvector:          case t_bitvector:
392                  if (vs_base[0]->bv.bv_adjustable ||  /*              if (vs_base[0]->bv.bv_adjustable || */
393                      vs_base[0]->bv.bv_hasfillp ||  /*                  vs_base[0]->bv.bv_hasfillp || */
394                      vs_base[0]->bv.bv_displaced->c.c_car == Cnil)  /*                  vs_base[0]->bv.bv_displaced->c.c_car == Cnil) */
395                          vs_base[0] = sLbit_vector;  /*                      vs_base[0] = sLbit_vector; */
396                  else  /*              else */
397                          vs_base[0] = sLsimple_bit_vector;            vs_base[0] = sLbit_vector;
398                  break;            break;
399    
400          case t_structure:          case t_structure:
401                                    
# Line 436  LFD(Ltype_of)(void) Line 443  LFD(Ltype_of)(void)
443                  break;                  break;
444    
445          case t_pathname:          case t_pathname:
446                  vs_base[0] = sLpathname;            if (pathname_lookup(vs_base[0]->pn.pn_host,sSApathname_logicalA->s.s_dbind)!=Cnil)
447                  break;              vs_base[0] = sLlogical_pathname;
448              else
449                vs_base[0] = sLpathname;
450              break;
451    
452          case t_random:          case t_random:
453                  vs_base[0] = sLrandom_state;                  vs_base[0] = sLrandom_state;
# Line 453  LFD(Ltype_of)(void) Line 463  LFD(Ltype_of)(void)
463                  vs_base[0] = sLcompiled_function;                  vs_base[0] = sLcompiled_function;
464                  break;                  break;
465    
466            case t_ifun:
467              vs_base[0]=sLinterpreted_function;
468              break;
469    
470          default:          default:
471                  error("not a lisp data object");                  error("not a lisp data object");
472          }          }
# Line 475  DEF_ORDINARY("SIMPLE-STRING",sLsimple_st Line 489  DEF_ORDINARY("SIMPLE-STRING",sLsimple_st
489  DEF_ORDINARY("FUNCTION",sLfunction,LISP,"");  DEF_ORDINARY("FUNCTION",sLfunction,LISP,"");
490  DEF_ORDINARY("FUNCTION-IDENTIFIER",sLfunction_identifier,LISP,"");  DEF_ORDINARY("FUNCTION-IDENTIFIER",sLfunction_identifier,LISP,"");
491  DEF_ORDINARY("COMPILED-FUNCTION",sLcompiled_function,LISP,"");  DEF_ORDINARY("COMPILED-FUNCTION",sLcompiled_function,LISP,"");
492    DEF_ORDINARY("INTERPRETED-FUNCTION",sLinterpreted_function,LISP,"");
493  DEF_ORDINARY("PATHNAME",sLpathname,LISP,"");  DEF_ORDINARY("PATHNAME",sLpathname,LISP,"");
494  DEF_ORDINARY("CHARACTER",sLcharacter,LISP,"");  DEF_ORDINARY("CHARACTER",sLcharacter,LISP,"");
495  DEF_ORDINARY("NUMBER",sLnumber,LISP,"");  DEF_ORDINARY("NUMBER",sLnumber,LISP,"");
# Line 505  DEF_ORDINARY("UNSIGNED-SHORT",sLunsigned Line 520  DEF_ORDINARY("UNSIGNED-SHORT",sLunsigned
520  DEF_ORDINARY("FIXNUM",sLfixnum,LISP,"");  DEF_ORDINARY("FIXNUM",sLfixnum,LISP,"");
521  DEF_ORDINARY("NON-NEGATIVE-FIXNUM",sLnon_negative_fixnum,LISP,"");  DEF_ORDINARY("NON-NEGATIVE-FIXNUM",sLnon_negative_fixnum,LISP,"");
522  DEF_ORDINARY("NEGATIVE-FIXNUM",sLnegative_fixnum,LISP,"");  DEF_ORDINARY("NEGATIVE-FIXNUM",sLnegative_fixnum,LISP,"");
523    DEF_ORDINARY("NON-NEGATIVE-BIGNUM",sLnon_negative_bignum,LISP,"");
524    DEF_ORDINARY("NEGATIVE-BIGNUM",sLnegative_bignum,LISP,"");
525  DEF_ORDINARY("SIGNED-FIXNUM",sLsigned_fixnum,LISP,"");  DEF_ORDINARY("SIGNED-FIXNUM",sLsigned_fixnum,LISP,"");
526  DEF_ORDINARY("UNSIGNED-FIXNUM",sLunsigned_fixnum,LISP,"");  DEF_ORDINARY("UNSIGNED-FIXNUM",sLunsigned_fixnum,LISP,"");
527    
# Line 657  gcl_init_typespec_function(void) Line 674  gcl_init_typespec_function(void)
674                                                              Cnil)))));                                                              Cnil)))));
675          enter_mark_origin(&TSor_pathname_string_symbol_stream);          enter_mark_origin(&TSor_pathname_string_symbol_stream);
676    
677          make_function("TYPE-OF", Ltype_of);          make_si_function("TYPE-OF-C", siLtype_of_c);
678  }                                }                              

Legend:
Removed from v.1.16  
changed lines
  Added in v.1.17

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