/[guile]/guile/guile-core/libguile/deprecated.c
ViewVC logotype

Diff of /guile/guile-core/libguile/deprecated.c

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

revision 1.8 by dirk, Mon Jun 2 20:54:21 2003 UTC revision 1.9 by mvo, Thu Jun 19 12:48:47 2003 UTC
# Line 40  Line 40 
40  #include "libguile/read.h"  #include "libguile/read.h"
41  #include "libguile/strports.h"  #include "libguile/strports.h"
42  #include "libguile/smob.h"  #include "libguile/smob.h"
43    #include "libguile/alist.h"
44    
45  #include <stdio.h>  #include <stdio.h>
46  #include <string.h>  #include <string.h>
# Line 667  scm_i_object_length (SCM obj) Line 668  scm_i_object_length (SCM obj)
668    abort ();    abort ();
669  }  }
670    
671    SCM
672    scm_sym2ovcell_soft (SCM sym, SCM obarray)
673    {
674      SCM lsym, z;
675      size_t hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray);
676    
677      scm_c_issue_deprecation_warning ("`scm_sym2ovcell_soft' is deprecated. "
678                                       "Use hashtables instead.");
679    
680      SCM_REDEFER_INTS;
681      for (lsym = SCM_VECTOR_REF (obarray, hash);
682           SCM_NIMP (lsym);
683           lsym = SCM_CDR (lsym))
684        {
685          z = SCM_CAR (lsym);
686          if (SCM_EQ_P (SCM_CAR (z), sym))
687            {
688              SCM_REALLOW_INTS;
689              return z;
690            }
691        }
692      SCM_REALLOW_INTS;
693      return SCM_BOOL_F;
694    }
695    
696    
697    SCM
698    scm_sym2ovcell (SCM sym, SCM obarray)
699    #define FUNC_NAME "scm_sym2ovcell"
700    {
701      SCM answer;
702    
703      scm_c_issue_deprecation_warning ("`scm_sym2ovcell' is deprecated. "
704                                       "Use hashtables instead.");
705    
706      answer = scm_sym2ovcell_soft (sym, obarray);
707      if (!SCM_FALSEP (answer))
708        return answer;
709      SCM_MISC_ERROR ("uninterned symbol: ~S", scm_list_1 (sym));
710      return SCM_UNSPECIFIED;               /* not reached */
711    }
712    #undef FUNC_NAME
713    
714    
715    /* Intern a symbol whose name is the LEN characters at NAME in OBARRAY.
716    
717       OBARRAY should be a vector of lists, indexed by the name's hash
718       value, modulo OBARRAY's length.  Each list has the form
719       ((SYMBOL . VALUE) ...), where SYMBOL is a symbol, and VALUE is the
720       value associated with that symbol (in the current module?  in the
721       system module?)
722    
723       To "intern" a symbol means: if OBARRAY already contains a symbol by
724       that name, return its (SYMBOL . VALUE) pair; otherwise, create a
725       new symbol, add the pair (SYMBOL . SCM_UNDEFINED) to the
726       appropriate list of the OBARRAY, and return the pair.
727    
728       If softness is non-zero, don't create a symbol if it isn't already
729       in OBARRAY; instead, just return #f.
730    
731       If OBARRAY is SCM_BOOL_F, create a symbol listed in no obarray and
732       return (SYMBOL . SCM_UNDEFINED).  */
733    
734    
735    SCM
736    scm_intern_obarray_soft (const char *name,size_t len,SCM obarray,unsigned int softness)
737    {
738      SCM symbol = scm_mem2symbol (name, len);
739      size_t raw_hash = SCM_SYMBOL_HASH (symbol);
740      size_t hash;
741      SCM lsym;
742    
743      scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. "
744                                       "Use hashtables instead.");
745    
746      if (SCM_FALSEP (obarray))
747        {
748          if (softness)
749            return SCM_BOOL_F;
750          else
751            return scm_cons (symbol, SCM_UNDEFINED);
752        }
753    
754      hash = raw_hash % SCM_VECTOR_LENGTH (obarray);
755    
756      for (lsym = SCM_VECTOR_REF(obarray, hash);
757           SCM_NIMP (lsym); lsym = SCM_CDR (lsym))
758        {
759          SCM a = SCM_CAR (lsym);
760          SCM z = SCM_CAR (a);
761          if (SCM_EQ_P (z, symbol))
762            return a;
763        }
764      
765      if (softness)
766        {
767          return SCM_BOOL_F;
768        }
769      else
770        {
771          SCM cell = scm_cons (symbol, SCM_UNDEFINED);
772          SCM slot = SCM_VECTOR_REF (obarray, hash);
773    
774          SCM_VECTOR_SET (obarray, hash, scm_cons (cell, slot));
775    
776          return cell;
777        }
778    }
779    
780    
781    SCM
782    scm_intern_obarray (const char *name,size_t len,SCM obarray)
783    {
784      scm_c_issue_deprecation_warning ("`scm_intern_obarray' is deprecated. "
785                                       "Use hashtables instead.");
786    
787      return scm_intern_obarray_soft (name, len, obarray, 0);
788    }
789    
790    /* Lookup the value of the symbol named by the nul-terminated string
791       NAME in the current module.  */
792    SCM
793    scm_symbol_value0 (const char *name)
794    {
795      scm_c_issue_deprecation_warning ("`scm_symbol_value0' is deprecated. "
796                                       "Use `scm_lookup' instead.");
797    
798      return scm_variable_ref (scm_c_lookup (name));
799    }
800    
801    SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0,
802               (SCM o, SCM s, SCM softp),
803                "Intern a new symbol in @var{obarray}, a symbol table, with name\n"
804                "@var{string}.\n\n"
805                "If @var{obarray} is @code{#f}, use the default system symbol table.  If\n"
806                "@var{obarray} is @code{#t}, the symbol should not be interned in any\n"
807                "symbol table; merely return the pair (@var{symbol}\n"
808                ". @var{#<undefined>}).\n\n"
809                "The @var{soft?} argument determines whether new symbol table entries\n"
810                "should be created when the specified symbol is not already present in\n"
811                "@var{obarray}.  If @var{soft?} is specified and is a true value, then\n"
812                "new entries should not be added for symbols not already present in the\n"
813                "table; instead, simply return @code{#f}.")
814    #define FUNC_NAME s_scm_string_to_obarray_symbol
815    {
816      SCM vcell;
817      SCM answer;
818      int softness;
819    
820      SCM_VALIDATE_STRING (2, s);
821      SCM_ASSERT (SCM_BOOLP (o) || SCM_VECTORP (o), o, SCM_ARG1, FUNC_NAME);
822    
823      scm_c_issue_deprecation_warning ("`string->obarray-symbol' is deprecated. "
824                                       "Use hashtables instead.");
825    
826      softness = (!SCM_UNBNDP (softp) && !SCM_FALSEP(softp));
827      /* iron out some screwy calling conventions */
828      if (SCM_FALSEP (o))
829        {
830          /* nothing interesting to do here. */
831          return scm_string_to_symbol (s);
832        }
833      else if (SCM_EQ_P (o, SCM_BOOL_T))
834        o = SCM_BOOL_F;
835        
836      vcell = scm_intern_obarray_soft (SCM_STRING_CHARS(s),
837                                       SCM_STRING_LENGTH (s),
838                                       o,
839                                       softness);
840      if (SCM_FALSEP (vcell))
841        return vcell;
842      answer = SCM_CAR (vcell);
843      return answer;
844    }
845    #undef FUNC_NAME
846    
847    SCM_DEFINE (scm_intern_symbol, "intern-symbol", 2, 0, 0,
848               (SCM o, SCM s),
849                "Add a new symbol to @var{obarray} with name @var{string}, bound to an\n"
850                "unspecified initial value.  The symbol table is not modified if a symbol\n"
851                "with this name is already present.")
852    #define FUNC_NAME s_scm_intern_symbol
853    {
854      size_t hval;
855      SCM_VALIDATE_SYMBOL (2,s);
856      if (SCM_FALSEP (o))
857        return SCM_UNSPECIFIED;
858    
859      scm_c_issue_deprecation_warning ("`intern-symbol' is deprecated. "
860                                       "Use hashtables instead.");
861    
862      SCM_VALIDATE_VECTOR (1,o);
863      hval = SCM_SYMBOL_HASH (s) % SCM_VECTOR_LENGTH (o);
864      /* If the symbol is already interned, simply return. */
865      SCM_REDEFER_INTS;
866      {
867        SCM lsym;
868        SCM sym;
869        for (lsym = SCM_VECTOR_REF (o, hval);
870             SCM_NIMP (lsym);
871             lsym = SCM_CDR (lsym))
872          {
873            sym = SCM_CAR (lsym);
874            if (SCM_EQ_P (SCM_CAR (sym), s))
875              {
876                SCM_REALLOW_INTS;
877                return SCM_UNSPECIFIED;
878              }
879          }
880        SCM_VECTOR_SET (o, hval,
881                        scm_acons (s, SCM_UNDEFINED,
882                                   SCM_VECTOR_REF (o, hval)));
883      }
884      SCM_REALLOW_INTS;
885      return SCM_UNSPECIFIED;
886    }
887    #undef FUNC_NAME
888    
889    SCM_DEFINE (scm_unintern_symbol, "unintern-symbol", 2, 0, 0,
890               (SCM o, SCM s),
891                "Remove the symbol with name @var{string} from @var{obarray}.  This\n"
892                "function returns @code{#t} if the symbol was present and @code{#f}\n"
893                "otherwise.")
894    #define FUNC_NAME s_scm_unintern_symbol
895    {
896      size_t hval;
897    
898      scm_c_issue_deprecation_warning ("`unintern-symbol' is deprecated. "
899                                       "Use hashtables instead.");
900    
901      SCM_VALIDATE_SYMBOL (2,s);
902      if (SCM_FALSEP (o))
903        return SCM_BOOL_F;
904      SCM_VALIDATE_VECTOR (1,o);
905      hval = SCM_SYMBOL_HASH (s) % SCM_VECTOR_LENGTH (o);
906      SCM_DEFER_INTS;
907      {
908        SCM lsym_follow;
909        SCM lsym;
910        SCM sym;
911        for (lsym = SCM_VECTOR_REF (o, hval), lsym_follow = SCM_BOOL_F;
912             SCM_NIMP (lsym);
913             lsym_follow = lsym, lsym = SCM_CDR (lsym))
914          {
915            sym = SCM_CAR (lsym);
916            if (SCM_EQ_P (SCM_CAR (sym), s))
917              {
918                /* Found the symbol to unintern. */
919                if (SCM_FALSEP (lsym_follow))
920                  SCM_VECTOR_SET (o, hval, lsym);
921                else
922                  SCM_SETCDR (lsym_follow, SCM_CDR(lsym));
923                SCM_ALLOW_INTS;
924                return SCM_BOOL_T;
925              }
926          }
927      }
928      SCM_ALLOW_INTS;
929      return SCM_BOOL_F;
930    }
931    #undef FUNC_NAME
932    
933    SCM_DEFINE (scm_symbol_binding, "symbol-binding", 2, 0, 0,
934               (SCM o, SCM s),
935                "Look up in @var{obarray} the symbol whose name is @var{string}, and\n"
936                "return the value to which it is bound.  If @var{obarray} is @code{#f},\n"
937                "use the global symbol table.  If @var{string} is not interned in\n"
938                "@var{obarray}, an error is signalled.")
939    #define FUNC_NAME s_scm_symbol_binding
940    {
941      SCM vcell;
942    
943      scm_c_issue_deprecation_warning ("`symbol-binding' is deprecated. "
944                                       "Use hashtables instead.");
945    
946      SCM_VALIDATE_SYMBOL (2,s);
947      if (SCM_FALSEP (o))
948        return scm_variable_ref (scm_lookup (s));
949      SCM_VALIDATE_VECTOR (1,o);
950      vcell = scm_sym2ovcell (s, o);
951      return SCM_CDR(vcell);
952    }
953    #undef FUNC_NAME
954    
955    #if 0
956    SCM_DEFINE (scm_symbol_interned_p, "symbol-interned?", 2, 0, 0,
957                (SCM o, SCM s),
958                "Return @code{#t} if @var{obarray} contains a symbol with name\n"
959                "@var{string}, and @code{#f} otherwise.")
960    #define FUNC_NAME s_scm_symbol_interned_p
961    {
962      SCM vcell;
963    
964      scm_c_issue_deprecation_warning ("`symbol-interned?' is deprecated. "
965                                       "Use hashtables instead.");
966    
967      SCM_VALIDATE_SYMBOL (2,s);
968      if (SCM_FALSEP (o))
969        {
970          SCM var = scm_sym2var (s, SCM_BOOL_F, SCM_BOOL_F);
971          if (var != SCM_BOOL_F)
972            return SCM_BOOL_T;
973          return SCM_BOOL_F;
974        }
975      SCM_VALIDATE_VECTOR (1,o);
976      vcell = scm_sym2ovcell_soft (s, o);
977      return (SCM_NIMP(vcell)
978              ? SCM_BOOL_T
979              : SCM_BOOL_F);
980    }
981    #undef FUNC_NAME
982    #endif
983    
984    SCM_DEFINE (scm_symbol_bound_p, "symbol-bound?", 2, 0, 0,
985                (SCM o, SCM s),
986                "Return @code{#t} if @var{obarray} contains a symbol with name\n"
987                "@var{string} bound to a defined value.  This differs from\n"
988                "@var{symbol-interned?} in that the mere mention of a symbol\n"
989                "usually causes it to be interned; @code{symbol-bound?}\n"
990                "determines whether a symbol has been given any meaningful\n"
991                "value.")
992    #define FUNC_NAME s_scm_symbol_bound_p
993    {
994      SCM vcell;
995    
996      scm_c_issue_deprecation_warning ("`symbol-bound?' is deprecated. "
997                                       "Use hashtables instead.");
998    
999      SCM_VALIDATE_SYMBOL (2,s);
1000      if (SCM_FALSEP (o))
1001        {
1002          SCM var = scm_sym2var (s, SCM_BOOL_F, SCM_BOOL_F);
1003          if (SCM_VARIABLEP(var) && !SCM_UNBNDP(SCM_VARIABLE_REF(var)))
1004            return SCM_BOOL_T;
1005          return SCM_BOOL_F;
1006        }
1007      SCM_VALIDATE_VECTOR (1,o);
1008      vcell = scm_sym2ovcell_soft (s, o);
1009      return SCM_BOOL (SCM_NIMP (vcell) && !SCM_UNBNDP (SCM_CDR (vcell)));
1010    }
1011    #undef FUNC_NAME
1012    
1013    
1014    SCM_DEFINE (scm_symbol_set_x, "symbol-set!", 3, 0, 0,
1015               (SCM o, SCM s, SCM v),
1016                "Find the symbol in @var{obarray} whose name is @var{string}, and rebind\n"
1017                "it to @var{value}.  An error is signalled if @var{string} is not present\n"
1018                "in @var{obarray}.")
1019    #define FUNC_NAME s_scm_symbol_set_x
1020    {
1021      SCM vcell;
1022    
1023      scm_c_issue_deprecation_warning ("`symbol-set!' is deprecated. "
1024                                       "Use the module system instead.");
1025    
1026      SCM_VALIDATE_SYMBOL (2,s);
1027      if (SCM_FALSEP (o))
1028        {
1029          scm_define (s, v);
1030          return SCM_UNSPECIFIED;
1031        }
1032      SCM_VALIDATE_VECTOR (1,o);
1033      vcell = scm_sym2ovcell (s, o);
1034      SCM_SETCDR (vcell, v);
1035      return SCM_UNSPECIFIED;
1036    }
1037    #undef FUNC_NAME
1038    
1039    #define MAX_PREFIX_LENGTH 30
1040    
1041    static int gentemp_counter;
1042    
1043    SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
1044                (SCM prefix, SCM obarray),
1045                "Create a new symbol with a name unique in an obarray.\n"
1046                "The name is constructed from an optional string @var{prefix}\n"
1047                "and a counter value.  The default prefix is @code{t}.  The\n"
1048                "@var{obarray} is specified as a second optional argument.\n"
1049                "Default is the system obarray where all normal symbols are\n"
1050                "interned.  The counter is increased by 1 at each\n"
1051                "call.  There is no provision for resetting the counter.")
1052    #define FUNC_NAME s_scm_gentemp
1053    {
1054      char buf[MAX_PREFIX_LENGTH + SCM_INTBUFLEN];
1055      char *name = buf;
1056      int len, n_digits;
1057    
1058      scm_c_issue_deprecation_warning ("`gentemp' is deprecated. "
1059                                       "Use `gensym' instead.");
1060    
1061      if (SCM_UNBNDP (prefix))
1062        {
1063          name[0] = 't';
1064          len = 1;
1065        }
1066      else
1067        {
1068          SCM_VALIDATE_STRING (1, prefix);
1069          len = SCM_STRING_LENGTH (prefix);
1070          if (len > MAX_PREFIX_LENGTH)
1071            name = SCM_MUST_MALLOC (MAX_PREFIX_LENGTH + SCM_INTBUFLEN);
1072          strncpy (name, SCM_STRING_CHARS (prefix), len);
1073        }
1074    
1075      if (SCM_UNBNDP (obarray))
1076        return scm_gensym (prefix);
1077      else
1078        SCM_ASSERT ((SCM_VECTORP (obarray) || SCM_WVECTP (obarray)),
1079                    obarray,
1080                    SCM_ARG2,
1081                    FUNC_NAME);
1082      do
1083        n_digits = scm_iint2str (gentemp_counter++, 10, &name[len]);
1084      while (!SCM_FALSEP (scm_intern_obarray_soft (name,
1085                                                   len + n_digits,
1086                                                   obarray,
1087                                                   1)));
1088      {
1089        SCM vcell = scm_intern_obarray_soft (name,
1090                                             len + n_digits,
1091                                             obarray,
1092                                             0);
1093        if (name != buf)
1094          scm_must_free (name);
1095        return SCM_CAR (vcell);
1096      }
1097    }
1098    #undef FUNC_NAME
1099    
1100  void  void
1101  scm_i_init_deprecated ()  scm_i_init_deprecated ()
1102  {  {

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

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