home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / runtime / ml_objects.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-02-09  |  1.4 KB  |  78 lines
  1. /* ml_objects.c
  2.  *
  3.  * COPYRIGHT 1990 by AT&T Bell Laboratories.
  4.  */
  5.  
  6. #include "ml_state.h"
  7. #include "ml_types.h"
  8.  
  9. /* the null string */
  10. #ifdef THINK_C
  11.        int string0[2] = {MAKE_DESC(0, TAG_string), 0};
  12. #else
  13. static int string0[2] = {MAKE_DESC(0, TAG_string), 0};
  14. #endif
  15.  
  16.  
  17. /* ML_alloc_string:
  18.  * Allocate and initialize an ML string.
  19.  */
  20. ML_val_t ML_alloc_string (msp, s)
  21.     MLState_ptr msp;
  22.     char    *s;
  23. {
  24.     register int len, n;
  25.     ML_val_t    res;
  26.  
  27.     len = strlen(s);
  28.     if (len == 0)
  29.     return PTR_CtoML(&string0[1]);
  30.     else if (len == 1)
  31.     return ((ML_val_t)INT_CtoML(*s));
  32.     else {
  33.     n = (len + 3) >> 2;
  34.     ML_alloc_write (msp, 0, MAKE_DESC(len, TAG_string));
  35.     res = ML_alloc (msp, n);
  36.     strncpy ((char *)PTR_MLtoC(res), s, len);
  37.     return res;
  38.     }
  39.  
  40. } /* end of ML_alloc_string. */
  41.  
  42. /* make_str_list:
  43.  * Make a ML list of ML strings from a NULL terminated (char *) vector.
  44.  */
  45. ML_val_t make_str_list (msp, vec)
  46.     MLState_ptr msp;
  47.     char    **vec;
  48. {
  49.     register int i;
  50.     ML_val_t    l;
  51.  
  52.     for (i = 0;  vec[i] != 0;  i++)
  53.     continue;
  54.     for (l = ML_nil;  --i >= 0; ) {
  55.     ML_val_t s = ML_alloc_string (msp, vec[i]);
  56.     l = ML_cons (msp, s, l);
  57.     }
  58.  
  59.     return l;
  60. }
  61.  
  62.  
  63. /* ML_eqstr:
  64.  * ML string equality.
  65.  */
  66. int ML_eqstr (s1, s2)
  67.     ML_val_t        s1, s2;
  68. {
  69.     register int l;
  70.  
  71.     if (s1 == s2)
  72.     return 1;
  73.     else if ((l = OBJ_LEN(s1)) != OBJ_LEN(s2))
  74.     return 0;
  75.     else
  76.     return (strncmp((char *)PTR_MLtoC(s1), (char *)PTR_MLtoC(s2), l) == 0);
  77. }
  78.