Ignore:
Timestamp:
Apr 17, 2011, 10:28:20 AM (11 years ago)
Author:
Sam Hocevar
Message:

lisp: populate LispSymbol? with symbol-related methods.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • abuse/trunk/src/lisp/lisp.cpp

    r483 r484  
    820820*/
    821821
    822 LispSymbol *find_symbol(char const *name)
    823 {
    824   LispSymbol *p=lsym_root;
    825   while (p)
    826   {
    827     int cmp=strcmp(name, ((char *)p->name)+sizeof(LispString));
    828     if (cmp==0) return p;
    829     else if (cmp<0) p=p->left;
    830     else p=p->right;
    831   }
    832   return NULL;
    833 }
    834 
    835 
    836 
    837 LispSymbol *make_find_symbol(char const *name)
    838 {
    839   LispSymbol *p=lsym_root;
    840   LispSymbol **parent=&lsym_root;
    841   while (p)
    842   {
    843     int cmp=strcmp(name, ((char *)p->name)+sizeof(LispString));
    844     if (cmp==0) return p;
    845     else if (cmp<0)
    846     {
    847       parent=&p->left;
    848       p=p->left;
    849     }
    850     else
    851     {
    852       parent=&p->right;
    853       p=p->right;
    854     }
    855   }
    856   int sp=current_space;
    857   if (current_space!=GC_SPACE)
    858      current_space=PERM_SPACE;       // make sure all symbols get defined in permanant space
    859 
    860   p=(LispSymbol *)malloc(sizeof(LispSymbol));
    861   p->type=L_SYMBOL;
    862   p->name=new_lisp_string(name);
    863 
    864   if (name[0]==':')     // constant, set the value to ourself
    865     p->value=p;
    866   else
    867     p->value=l_undefined;
    868   p->function=l_undefined;
     822LispSymbol *LispSymbol::Find(char const *name)
     823{
     824    LispSymbol *p = lsym_root;
     825    while (p)
     826    {
     827        int cmp = strcmp(name, ((char *)p->name) + sizeof(LispString));
     828        if (cmp == 0)
     829            return p;
     830        p = (cmp < 0) ? p->left : p->right;
     831    }
     832    return NULL;
     833}
     834
     835LispSymbol *LispSymbol::FindOrCreate(char const *name)
     836{
     837    LispSymbol *p = lsym_root;
     838    LispSymbol **parent = &lsym_root;
     839    while (p)
     840    {
     841        int cmp = strcmp(name, ((char *)p->name) + sizeof(LispString));
     842        if (cmp == 0)
     843            return p;
     844        parent = (cmp < 0) ? &p->left : &p->right;
     845        p = *parent;
     846    }
     847
     848    // Make sure all symbols get defined in permanant space
     849    int sp = current_space;
     850    if (current_space != GC_SPACE)
     851       current_space = PERM_SPACE;
     852
     853    p = (LispSymbol *)malloc(sizeof(LispSymbol));
     854    p->type = L_SYMBOL;
     855    p->name = new_lisp_string(name);
     856
     857    // If constant, set the value to ourself
     858    p->value = (name[0] == ':') ? p : l_undefined;
     859    p->function = l_undefined;
    869860#ifdef L_PROFILE
    870   p->time_taken=0;
    871 #endif
    872   p->left=p->right=NULL;
    873   *parent=p;
    874   ltotal_syms++;
    875 
    876   current_space=sp;
    877   return p;
    878 }
    879 
     861    p->time_taken = 0;
     862#endif
     863    p->left = p->right = NULL;
     864    *parent = p;
     865    ltotal_syms++;
     866
     867    current_space = sp;
     868    return p;
     869}
    880870
    881871void ldelete_syms(LispSymbol *root)
     
    898888    {
    899889      if (lisp_eq(CAR(CAR(list)), item))
    900         return lcar(list);   
     890        return lcar(list);
    901891      list=(LispList *)(CDR(list));
    902892    }
     
    967957}
    968958
    969 void *lookup_symbol_function(void *symbol)
    970 {
    971   return ((LispSymbol *)symbol)->function;
    972 }
    973 
    974 void set_symbol_function(void *symbol, void *function)
    975 {
    976   ((LispSymbol *)symbol)->function=function;
    977 }
    978 
    979 void *lookup_symbol_value(void *symbol)
    980 {
    981 #ifdef TYPE_CHECKING
    982   if (((LispSymbol *)symbol)->value!=l_undefined)
    983 #endif
    984     return ((LispSymbol *)symbol)->value;
    985 #ifdef TYPE_CHECKING
    986   else
    987   {
    988     lprint(symbol);
    989     lbreak(" has no value\n");
    990     exit(0);
    991   }
    992 #endif
    993   return NULL;
    994 }
    995 
    996 void set_variable_value(void *symbol, void *value)
    997 {
    998   ((LispSymbol *) symbol)->value=value;
     959void LispSymbol::SetFunction(void *fun)
     960{
     961    function = fun;
    999962}
    1000963
     
    1002965{
    1003966  need_perm_space("add_sys_function");
    1004   LispSymbol *s=make_find_symbol(name);
     967  LispSymbol *s = LispSymbol::FindOrCreate(name);
    1005968  if (s->function!=l_undefined)
    1006969  {
     
    1018981  if (s->value!=l_undefined)
    1019982  {
    1020     lbreak("add_c_object -> symbol %s already has a value\n", lstring_value(symbol_name(s)));
     983    lbreak("add_c_object -> symbol %s already has a value\n", lstring_value(s->GetName()));
    1021984    exit(0);
    1022985  }
     
    1029992  total_user_functions++;
    1030993  need_perm_space("add_c_function");
    1031   LispSymbol *s=make_find_symbol(name);
     994  LispSymbol *s = LispSymbol::FindOrCreate(name);
    1032995  if (s->function!=l_undefined)
    1033996  {
     
    10431006  total_user_functions++;
    10441007  need_perm_space("add_c_bool_fun");
    1045   LispSymbol *s=make_find_symbol(name);
     1008  LispSymbol *s = LispSymbol::FindOrCreate(name);
    10461009  if (s->function!=l_undefined)
    10471010  {
     
    10581021  total_user_functions++;
    10591022  need_perm_space("add_c_bool_fun");
    1060   LispSymbol *s=make_find_symbol(name);
     1023  LispSymbol *s = LispSymbol::FindOrCreate(name);
    10611024  if (s->function!=l_undefined)
    10621025  {
     
    12861249      void *cs=new_cons_cell(), *c2=NULL, *tmp;
    12871250      p_ref r4(cs), r5(c2);
    1288       tmp=make_find_symbol("function");
     1251      tmp = LispSymbol::FindOrCreate("function");
    12891252      ((LispList *)cs)->car=tmp;
    12901253      c2=new_cons_cell();
     
    13001263    }
    13011264  } else {
    1302     ret = make_find_symbol(n);
     1265    ret = LispSymbol::FindOrCreate(n);
    13031266  }
    13041267  return ret;
     
    15871550    {
    15881551      char st[100];
    1589       sprintf(st, "%20s %f\n", lstring_value(symbol_name(p)), ((LispSymbol *)p)->time_taken);
     1552      sprintf(st, "%20s %f\n", lstring_value(p->GetName()), p->time_taken);
    15901553      out->write(st, strlen(st));
    15911554    }
     
    21492112    case SYS_FUNC_DEFUN:
    21502113    {
    2151       void *symbol=CAR(arg_list);
     2114      LispSymbol *symbol = (LispSymbol *)CAR(arg_list);
    21522115#ifdef TYPE_CHECKING
    21532116      if (item_type(symbol)!=L_SYMBOL)
     
    21742137      LispUserFunction *ufun=new_lisp_user_function(lcar(lcdr(arg_list)), block_list);
    21752138#endif
    2176       set_symbol_function(symbol, ufun);
     2139      symbol->SetFunction(ufun);
    21772140      ret=symbol;
    21782141    } break;
     
    22792242    } break;
    22802243    case SYS_FUNC_FUNCTION:
    2281       ret=lookup_symbol_function(eval(CAR(arg_list)));
     2244      ret = ((LispSymbol *)eval(CAR(arg_list)))->GetFunction();
    22822245    break;
    22832246    case SYS_FUNC_MAPCAR:
     
    24022365            {
    24032366                delete fp;
    2404                 if( DEFINEDP(symbol_value(load_warning)) && symbol_value(load_warning) )
     2367                if( DEFINEDP(((LispSymbol *)load_warning)->GetValue())
     2368                     && ((LispSymbol *)load_warning)->GetValue())
    24052369                    dprintf("Warning : file %s does not exist\n", st);
    24062370                ret = NULL;
     
    25602524    case SYS_FUNC_FOR:
    25612525    {
    2562       void *bind_var=CAR(arg_list); arg_list=CDR(arg_list);
     2526      LispSymbol *bind_var = (LispSymbol *)CAR(arg_list);
     2527      arg_list = CDR(arg_list);
    25632528      p_ref r1(bind_var);
    25642529      if (item_type(bind_var)!=L_SYMBOL)
     
    25782543      void *block=NULL, *ret=NULL;
    25792544      p_ref r3(block);
    2580       l_user_stack.push(symbol_value(bind_var));  // save old symbol value
     2545      l_user_stack.push(bind_var->GetValue());  // save old symbol value
    25812546      while (ilist)
    25822547      {
    2583                 set_symbol_value(bind_var, CAR(ilist));
     2548                bind_var->SetValue(CAR(ilist));
    25842549                for (block=arg_list;block;block=CDR(block))
    25852550                  ret=eval(CAR(block));
    25862551                ilist=CDR(ilist);
    25872552      }
    2588       set_symbol_value(bind_var, l_user_stack.pop(1));
     2553      bind_var->SetValue(l_user_stack.pop(1)); // restore symbol value
    25892554      ret=ret;
    25902555    } break;
     
    27292694      p_ref r1(init_var);
    27302695      int i, ustack_start=l_user_stack.son;      // restore stack at end
    2731       void *sym=NULL;
     2696      LispSymbol *sym = NULL;
    27322697      p_ref r2(sym);
    27332698
     
    27352700      for (init_var=CAR(arg_list);init_var;init_var=CDR(init_var))
    27362701      {
    2737                 sym=CAR(CAR(init_var));
     2702                sym = (LispSymbol *)CAR(CAR(init_var));
    27382703                if (item_type(sym)!=L_SYMBOL)
    27392704                { lbreak("expecting symbol name for iteration var\n"); exit(0); }
    2740                 l_user_stack.push(symbol_value(sym));
     2705                l_user_stack.push(sym->GetValue());
    27412706      }
    27422707
     
    27492714      for (init_var=CAR(arg_list);init_var;init_var=CDR(init_var), do_evaled++)
    27502715      {
    2751                 sym=CAR(CAR(init_var));
    2752                 set_symbol_value(sym, *do_evaled);
     2716                sym = (LispSymbol *)CAR(CAR(init_var));
     2717                sym->SetValue(*do_evaled);
    27532718      }
    27542719
     
    27712736      for (init_var=CAR(arg_list);init_var;init_var=CDR(init_var), do_evaled++)
    27722737      {
    2773                 sym=CAR(CAR(init_var));
    2774                 set_symbol_value(sym, *do_evaled);
     2738                sym = (LispSymbol *)CAR(CAR(init_var));
     2739                sym->SetValue(*do_evaled);
    27752740      }
    27762741
     
    30503015        else
    30513016                {
    3052                   ret=lookup_symbol_value(prog);
     3017                  ret = ((LispSymbol *)prog)->GetValue();
    30533018                  if (item_type(ret)==L_OBJECT_VAR)
    30543019                    ret=l_obj_get(((LispObjectVar *)ret)->number);
     
    31623127}
    31633128
    3164 void *symbol_name(void *symbol)
    3165 {
    3166   return ((LispSymbol *)symbol)->name;
    3167 }
    3168 
    3169 
    3170 void *set_symbol_number(void *symbol, long num)
     3129void *LispSymbol::GetName()
    31713130{
    31723131#ifdef TYPE_CHECKING
    3173   if (item_type(symbol)!=L_SYMBOL)
    3174   {
    3175     lprint(symbol);
    3176     lbreak("is not a symbol\n");
    3177     exit(0);
    3178   }
    3179 #endif
    3180   if (((LispSymbol *)symbol)->value!=l_undefined &&
    3181       item_type(((LispSymbol *)symbol)->value)==L_NUMBER)
    3182     ((LispNumber *)((LispSymbol *)symbol)->value)->num=num;
    3183   else
    3184     ((LispSymbol *)(symbol))->value=new_lisp_number(num);
    3185 
    3186   return ((LispSymbol *)(symbol))->value;
    3187 }
    3188 
    3189 void *set_symbol_value(void *symbol, void *value)
     3132    if (item_type(this) != L_SYMBOL)
     3133    {
     3134        lprint(this);
     3135        lbreak("is not a symbol\n");
     3136        exit(0);
     3137    }
     3138#endif
     3139    return name;
     3140}
     3141
     3142void *LispSymbol::SetNumber(long num)
    31903143{
    31913144#ifdef TYPE_CHECKING
    3192   if (item_type(symbol)!=L_SYMBOL)
    3193   {
    3194     lprint(symbol);
    3195     lbreak("is not a symbol\n");
    3196     exit(0);
    3197   }
    3198 #endif
    3199   ((LispSymbol *)(symbol))->value=value;
    3200   return value;
    3201 }
    3202 
    3203 void *symbol_function(void *symbol)
     3145    if (item_type(this) != L_SYMBOL)
     3146    {
     3147        lprint(this);
     3148        lbreak("is not a symbol\n");
     3149        exit(0);
     3150    }
     3151#endif
     3152    if (value != l_undefined && item_type(value) == L_NUMBER)
     3153        ((LispNumber *)value)->num = num;
     3154    else
     3155        value = new_lisp_number(num);
     3156
     3157    return value;
     3158}
     3159
     3160void *LispSymbol::SetValue(void *val)
    32043161{
    32053162#ifdef TYPE_CHECKING
    3206   if (item_type(symbol)!=L_SYMBOL)
    3207   {
    3208     lprint(symbol);
    3209     lbreak("is not a symbol\n");
    3210     exit(0);
    3211   }
    3212 #endif
    3213   return ((LispSymbol *)symbol)->function;
    3214 }
    3215 
    3216 void *symbol_value(void *symbol)
     3163    if (item_type(this) != L_SYMBOL)
     3164    {
     3165        lprint(this);
     3166        lbreak("is not a symbol\n");
     3167        exit(0);
     3168    }
     3169#endif
     3170    value = val;
     3171    return value;
     3172}
     3173
     3174void *LispSymbol::GetFunction()
    32173175{
    32183176#ifdef TYPE_CHECKING
    3219   if (item_type(symbol)!=L_SYMBOL)
    3220   {
    3221     lprint(symbol);
    3222     lbreak("is not a symbol\n");
    3223     exit(0);
    3224   }
    3225 #endif
    3226   return ((LispSymbol *)symbol)->value;
    3227 }
    3228 
    3229 
    3230 
    3231 
    3232 
    3233 
     3177    if (item_type(this) != L_SYMBOL)
     3178    {
     3179        lprint(this);
     3180        lbreak("is not a symbol\n");
     3181        exit(0);
     3182    }
     3183#endif
     3184    return function;
     3185}
     3186
     3187void *LispSymbol::GetValue()
     3188{
     3189#ifdef TYPE_CHECKING
     3190    if (item_type(this) != L_SYMBOL)
     3191    {
     3192        lprint(this);
     3193        lbreak("is not a symbol\n");
     3194        exit(0);
     3195    }
     3196#endif
     3197    return value;
     3198}
     3199
Note: See TracChangeset for help on using the changeset viewer.