Roxen.git / server / modules / tags / lisp.pike

version» Context lines:

Roxen.git/server/modules/tags/lisp.pike:1:   #define error(X) throw( ({ (X), backtrace() }) ) - constant cvs_version = "$Id: lisp.pike,v 1.3 1998/01/29 15:02:16 per Exp $"; + constant cvs_version = "$Id: lisp.pike,v 1.4 1998/01/29 16:16:49 per Exp $";      #include <module.h>   inherit "module";      constant thread_safe=1;      array register_module()   {    return ({ MODULE_PARSER, "Lisp tag module",    "This module defines a new tag, "
Roxen.git/server/modules/tags/lisp.pike:371:    object res = env->copy();    return build_env1(res, formals, arglist) ? res : 0;    }       object new_env(object env, object arglist);       object apply(object arglist, object env, object globals)    {    env = new_env(env, arglist);    if (env) -  return list->map("eval", env, globals); +  return arglist->map("eval", env, globals);    error("Nothing to apply with.");    }    }       class Lexical    {    inherit Lambda : l;    object env;       void create(object e, object formals_list, object expressions)
Roxen.git/server/modules/tags/lisp.pike:621:    while(!arglist->cdr->is_nil)    {    res = arglist->car->eval(env, globals);    if (!res || !res->is_nil)    return res;    arglist = arglist->cdr;    }    return arglist->car->eval(env, globals);   }    +  + object s_and(object arglist, object env, object globals) + { +  object res; +  while(!arglist->cdr->is_nil) +  { +  res = arglist->car->eval(env, globals); +  if (!res || res->is_nil) +  return res; +  arglist = arglist->cdr; +  } +  return arglist->car->eval(env, globals); + } +    object s_progn(object arglist, object env, object globals)   {    return arglist->map("eval", env, globals);   }      object s_lambda(object arglist, object env, object globals)   {    return Lexical(env, arglist->car, arglist->cdr);   }      /* In general, errors are signaled by returning 0, and are    * fatal.    *    * The catch special form catches errors, returning nil    * if an error occured. */   object s_catch(object arglist, object env, object globals)   {    return s_progn(arglist, env, globals) || Nil;   }    -  +  +  + object s_while(object arglist, object env, object globals) + { +  object expr = arglist->car; +  object to_eval = arglist->cdr; +  +  while(!expr->eval(env,globals)->is_nil) +  { +  object f = to_eval; +  while( f->car && !f->car->is_nil ) +  { +  if(!f->car->eval(env,globals)) return 0; +  f = f->cdr; +  } +  } + } +    void init_specials(object environment)   {    environment->extend(make_symbol("quote"), Special(s_quote));    environment->extend(make_symbol("set!"), Special(s_setq));    environment->extend(make_symbol("setq"), Special(s_setq));    environment->extend(make_symbol("define"), Special(s_define)); -  +  environment->extend(make_symbol("while"), Special(s_while));    environment->extend(make_symbol("defmacro"), Special(s_defmacro));    environment->extend(make_symbol("lambda"), Special(s_lambda));    environment->extend(make_symbol("if"), Special(s_if));    environment->extend(make_symbol("or"), Special(s_or)); -  +  environment->extend(make_symbol("while"), Special(s_while)); +  environment->extend(make_symbol("and"), Special(s_and));    environment->extend(make_symbol("progn"), Special(s_progn));    environment->extend(make_symbol("catch"), Special(s_catch));   }         object f_car(object arglist, object env, object globals)   {    return arglist->car->car;   }   
Roxen.git/server/modules/tags/lisp.pike:767:   {    return ( (arglist->car == arglist->cdr->car)    || (arglist->car->value == arglist->cdr->car->value)) ? True : Nil;   }      object f_lt(object arglist, object env, object globals)   {    return (arglist->car->value < arglist->cdr->car->value) ? True : Nil;   }    + object f_gt(object arglist, object env, object globals) + { +  return (arglist->car->value > arglist->cdr->car->value) ? True : Nil; + }    -  +    object f_get(object arglist, object env, object globals)   {    if(globals->id->variables[arglist->car->value])    return String( globals->id->variables[arglist->car->value] );    if(globals->id->misc->defines[arglist->car->value])    return String( globals->id->misc->defines[arglist->car->value] );    return Nil;   }      object f_get_id_int(object arglist, object env, object globals)
Roxen.git/server/modules/tags/lisp.pike:855:    args+=({(int)arglist->car->value});    else    args+=({arglist->car->value});    }    if(!stringp(f)) {    return 0;    }    return String( sprintf(f, @args) );   }    + object f_line_break(object arglist, object env, object globals) + { +  string f = arglist->car->print(); +  int n = (arglist->cdr && (int)arglist->cdr->car->value) || 75; +  string res = ""; +  while(strlen(f)) +  { +  res += f[..n-1]+"\n"; +  f = f[n..]; +  } +  return String( res ); + }      object boot_code;      void init_functions(object environment)   {    environment->extend(make_symbol("+"), Builtin(f_add));    environment->extend(make_symbol("*"), Builtin(f_mult));    environment->extend(make_symbol("-"), Builtin(f_subtract));    environment->extend(make_symbol("="), Builtin(f_equal));    environment->extend(make_symbol("<"), Builtin(f_lt)); -  +  environment->extend(make_symbol(">"), Builtin(f_gt));       environment->extend(make_symbol("concat"), Builtin(f_concat));    environment->extend(make_symbol("format"), Builtin(f_format));       environment->extend(make_symbol("variable"), Builtin(f_get));    environment->extend(make_symbol("variable-number"), Builtin(f_getint));       environment->extend(make_symbol("id"), Builtin(f_get_id));    environment->extend(make_symbol("id-number"), Builtin(f_get_id_int));    environment->extend(make_symbol("output"), Builtin(f_output));
Roxen.git/server/modules/tags/lisp.pike:888:    environment->extend(make_symbol("princ"), Builtin(f_print));    environment->extend(make_symbol("eval"), Builtin(f_eval));    environment->extend(make_symbol("apply"), Builtin(f_apply));    environment->extend(make_symbol("global-environment"), environment);    environment->extend(make_symbol("car"), Builtin(f_car));    environment->extend(make_symbol("cdr"), Builtin(f_cdr));    environment->extend(make_symbol("setcar!"), Builtin(f_setcar));    environment->extend(make_symbol("setcdr!"), Builtin(f_setcdr));    environment->extend(make_symbol("cons"), Builtin(f_cons));    environment->extend(make_symbol("list"), Builtin(f_list)); +  +  environment->extend(make_symbol("line-break"), Builtin(f_line_break));   }         void init_for(object e)   {    init_specials(e);    init_functions(e);    boot_code->eval(e,e);   }