/*
  Scheme in Javascript, written by Luke Gorrie <luke@bluetail.com> in
  October 2000.

  Implementation notes:

  - Much of the code is somewhat recursive, which won't
    scale. Recursing beyond about 100 levels in Javascript kills
    Netscape.

  - BUG: macros are expanded even inside `quote's.

*/

// ----------------------------------------------------------------------
// Tokenizer
// ----------------------------------------------------------------------

function tokenise (source) {
  str = discard_comments (source);
  var idx = 0;
  var end = str.length;
  var c;
  var token_acc = nil;
  atom_acc = "";
  while (idx < end) {
    c = str.charAt(idx);
    // check for unquote-splicing
    if ((c == ",") && ((idx + 1) < end) && (str.charAt(idx + 1) == "@")) {
      token_acc = cons (",@", tokenise_update_acc (atom_acc, token_acc));
      atom_acc = "";
      idx += 2;
    } else if (special_char (c)) {
      token_acc = cons (c, tokenise_update_acc (atom_acc, token_acc));
      atom_acc = "";
      idx++;
    } else if (whitespace_p (c)) {
      token_acc = tokenise_update_acc (atom_acc, token_acc);
      atom_acc = "";
      idx++;
    } else if ((c == "\"") && ((idx == 0) ||
                               (str.charAt(idx - 1) != "\\"))) {
      var string_acc = "";
      // advance idx to end of string, adding to the accumulator
      while ((++idx < end) &&
             ((str.charAt (idx) != "\"") ||
              (str.charAt (idx - 1) == "\\"))) {
        if ((str.charAt (idx)   == "\"") &&
            (str.charAt (idx-1) == "\\")) {
          string_acc += "\"";
        } else {
          string_acc += str.charAt (idx);
        }
      }
      if ((idx == end) && (str.charAt (idx) != "\"")) {
        alert ("Unterminated string literal");
      } else {
        token_acc = cons ("\""+string_acc+"\"",
                          tokenise_update_acc (atom_acc, token_acc));
        atom_acc = "";
        idx++;
      }
    } else {
      atom_acc += c;
      idx++;
    }
  }
  return reverse (tokenise_update_acc (atom_acc, token_acc));
}

function tokenise_update_acc (atom_acc, token_acc) {
  if (atom_acc.length == 0) {
    return token_acc;
  } else {
    return cons (atom_acc, token_acc);
  }
}

function special_char (c) {
  if ((c == "(") ||
      (c == ")") ||
      (c == "'") ||
      (c == "`") ||
      (c == ",")) {
    return true;
  } else {
    return false;
  }
}

function prepend_acc (acc, lst) {
  switch (acc) {
  case "":
    return lst;
  default:
    return cons (acc, lst);
  }
}

function digit_p (ch) {
  if (ch == "") return false;
  return ("0123456789".indexOf(ch) >= 0);
}

function alpha_p (ch) {
  if (ch == "") return false;
  return ("ABCDEFGHIJKLMNOPQRSTUVWXYZ-!?_$%".indexOf(ch.toUpperCase()) >= 0);
}

function alpha_or_digit_p (ch) {
  if (ch == "") return false;
  return (digit_p (ch) || alpha_p (ch));
}

function whitespace_p (ch) {
  if (ch == "") return false;
  return (" \t\n".indexOf(ch) >= 0);
}

function discard_comments (str) {
  var idx = 0;
  var start_idx = 0;
  var acc = "";
  while (idx < str.length) {
    if (str.charAt (idx) == ";") {
      acc += str.substring (start_idx, idx);
      while ((idx < str.length) &&
             (str.charAt (idx) != "\n")) {
        idx++;
      }
      start_idx = ++idx;
    } else {
      idx++;
    }
  }
  return acc + str.substring (start_idx, idx);
}

// ----------------------------------------------------------------------
// Parser
// ----------------------------------------------------------------------

// returns: (ParseTree, LeftoverTokens)
function parse_string (str) {
  return parse_all (tokenise (str));
}

function parse_all (lst) {
  var acc = nil;
  var input = lst;
  while (! null_p (input)) {
    var x = parse (input);
    acc = cons (car (x), acc);
    input = cdr (x);
  }
  return reverse (acc);
}

function parse (lst) {
  var head = car (lst);
  var tail = cdr (lst);
  switch (head) {
  case "(":
    return parse_list (tail);
  case ")":
    alert ("Unexpected close-paren in input");
    break;
  default:
    if (digit_p (head.charAt (0))) {
      // number
      return cons (parseInt (head), tail);
    } else if (head.charAt (0) == "\"") {
      return cons (make_string (head.substring(1, head.length - 1)), tail);
    }
    else {
      // symbol
      return cons (head, tail);
    }
  }
}

// `lst' must be a list of tokens directly following a "("
// Returns: (parsed-list . leftover-tokens)
function parse_list (lst) {
  var acc = nil;
  var input = lst;
  while (true) {                // while (true) -- yick!
    if (null_p (input)) {
      alert ("Unterminated list");
      return null;
    } else if (car (input) == ")") {
      return cons (reverse (acc), cdr (input));
    } else {
      var x = parse (input);
      acc = cons (car (x), acc);
      input = cdr (x);
    }
  }
}

function reverse (lst) {
  var acc = nil;
  var input = lst;
  while (! null_p (input)) {
    acc = cons (car (input), acc);
    input = cdr (input);
  }
  return acc;
}

// RECURSIVE
function list_length (lst) {
  if (null_p (lst)) {
    return 0;
  } else {
    return 1 + list_length (cdr (lst));
  }
}

// ----------------------------------------------------------------------
// Runtime
// ----------------------------------------------------------------------

// ----------------------------------------------------------------------
// Lists

nil = {type:"nil"};
nil.toString = function () { return "()"; };

function cons (Car, Cdr) {
  var Cons = {type: "cons", car: Car, cdr: Cdr};
  Cons.toString = function() { return "(" + strings_with_spaces (this) + ")" };
  return Cons;
}

function car (Cons) {
  if (! cons_p (Cons)) {
    alert ("bad argument to car: " + Cons);
  }
  return Cons.car;
}

function cdr (Cons) {
  if (! cons_p (Cons)) {
    alert ("bad argument to cdr: " + Cons);
  }
  return Cons.cdr;
}

function cadr (Cons) {
  return car (cdr (Cons));
}

function make_string (str) {
  var obj = {type:"string", body:str};
  obj.toString = function () { return "\"" + this.body + "\""; }
  return obj;
}

function list_append (A, B) {
  if (null_p (A)) {
    return B;
  } else {
    return cons (car (A), list_append (cdr (A), B));
  }
}

function list_p (Obj) {
  if (null_p (Obj)) {
    return true;
  } else if (cons_p (Obj)) {
    return cons_p (cdr (Obj));
  } else {
    return false;
  }
}

function cons_p (Obj) {
  return (typeof Obj == "object") && (Obj.type == "cons");
}

function to_string (Obj) {
  switch (Obj) {
  case true:
    return "#t";
  case false:
    return "#f";
  default:
    if (typeof Obj == "object") {
      return Obj.toString ();
    } else {
      return new String (Obj);
    }
  }
}

function strings_with_spaces (lst) {
  var acc = "";
  var input = lst;
  while (! (null_p (input))) {
    if (cons_p (cdr (input))) {
      acc += to_string (car (input)) + " ";
      input = cdr (input);
    } else if (null_p (cdr (input))) {
      acc += to_string (car (input));
      input = cdr (input);
    } else {
      acc += to_string (car (input)) + " . " + to_string (cdr (input));
      input = nil;
    }
  }
  return acc;
}

function null_p (Obj) {
  return object_p (Obj) && (Obj.type == "nil");
}

function symbol_p (Obj) {
  return typeof Obj == "string";
}

function number_p (Obj) {
  return typeof Obj == "number";
}

function string_p (Obj) {
  return (typeof Obj == "object") && (Obj.type == "string");
}

function number_p (Obj) {
  return typeof Obj == "number";
}

function atom_p (Obj) {
  return symbol_p (Obj) || atom_p (Obj);
}

function object_p (Obj) {
  return (typeof Obj == "object") && (Obj.type != "undefined");
}

// ----------------------------------------------------------------------
// Evaluator
// ----------------------------------------------------------------------

function interpret (Program) {
  eval_depth = 0;
  var ParseTree = analyse (parse_string (Program));
  var Form = cons ("begin", ParseTree);
  return to_string (evaluate (Form, TOP_ENV));
}

function evaluate (InputForm, Env) {
  if (++eval_depth >= MAX_EVAL_DEPTH) {
    var rsn = "MAX_EVAL_DEPTH exceeded; rewrite evaluator loop and retry";
    document.write ("<p><i>" + rsn + "</i><p>");
    abort (rsn);
  }
  var code = cons (InputForm, nil);
  var code_stack = nil;
  var env_stack = nil;
  var result = nil;
  while (!null_p (code) || !null_p (code_stack)) {
    // finished at this level?
    while (null_p (code)) {
      if (null_p (code_stack)) {
        --eval_depth;
        return result;
      }
      code = car (code_stack);
      Env = car (env_stack);
      code_stack = cdr (code_stack);
      env_stack  = cdr (env_stack);
    }
    var Form = car (code);
    code = cdr (code);
    if (number_p (Form) || string_p (Form)) {
      result = Form;
      continue;
    } else if (symbol_p (Form)) {
      switch (Form) {
      case "#t":
        result = true;
        continue;
      case "#f":
        result = true;
        continue;
      default:
        var x = env_lookup(Form, Env);
        if (x == NOT_FOUND) {
          alert("Unbound variable: \"" + Form + "\"");
        } else {
          result = x;
          continue;
        }
      }
    } else if (list_p (Form)) {
      var FName = car (Form);
      var Args = cdr (Form);
      switch (FName) {
        // ------------------------------------------------------------
        // Specials
        // ------------------------------------------------------------
      case "define":
        var Name = car (Args);
        var Value = car (cdr (Args));
        env_add_binding (Name, evaluate (Value, Env), Env);
        result = true;
        continue;
      case "lambda":
        var LambdaList = car (Args);
        var Body = cdr (Args);
        result = make_function (LambdaList, Body, Env);
        continue;
      case "if":
        var TestVal = evaluate (car (Args), Env);
        if (TestVal) {
          result = evaluate (cadr (Args), Env);
          continue;
        } else if (null_p (cdr (cdr (Args)))) {
          result = false;
          continue;
        } else {
          result = evaluate (car (cdr (cdr (Args))), Env);
          continue;
        }
      case "quote":
        result = car (Args);
        continue;
      case "quasiquote":
        result = eval_quasiquote (car (Args), Env);
        continue;
      case "defmacro":
        var Name = car (Args);
        var Body = cadr (Args);
        env_add_binding (Name, evaluate (Body, Env), MACRO_ENV);
        result = true;
        continue;
      case "begin":
        code_stack = cons (code, code_stack);
        env_stack  = cons (Env, env_stack);
        code = Args;
        continue;
      case "list":
        // RECURSE
        result = evaluate_each (Args, Env);
        continue;
      default:
        var Macro = env_lookup (FName, MACRO_ENV);
        if (Macro != NOT_FOUND) {
          var expansion = expand_macro (Macro, Args);
          // RECURSE
          code = cons (expansion, code);
          continue;
        }
        else {
          // RECURSE
          var fun = evaluate (FName, Env);
          if (builtin_p (fun)) {
            var arg_vals = evaluate_each (Args, Env);
            result = fun.body (arg_vals);
            continue;
          }
          else {
            var fargs = nil;
            var fenv = nil;
            if (special_p (fun)) {
              fargs = Args;
              fenv = Env;
            } else {
              // RECURSE
              fargs = evaluate_each(Args, Env);
              fenv = env_extend (fun.args, fargs, Env);
            }
            code_stack = cons (code, code_stack);
            env_stack  = cons (Env, env_stack);
            code = fun.body;
            Env = fenv;
            continue;
          }
        }
      }
    }
  }
  --eval_depth;
  return result;
}

// RECURSIVE
function evaluate_old (Form, Env) {
  if (++eval_depth >= MAX_EVAL_DEPTH) {
    var rsn = "MAX_EVAL_DEPTH exceeded; rewrite evaluator loop and retry";
    document.write ("<p><i>" + rsn + "</i><p>");
    abort (rsn);
  }
  if (number_p (Form) || string_p (Form)) {
    return Form;
  } else if (symbol_p (Form)) {
    switch (Form) {
    case "#t":
      return true;
    case "#f":
      return false;
    default:
      var x = env_lookup(Form, Env);
      if (x == NOT_FOUND) {
        alert("Unbound variable: \"" + Form + "\"");
      } else {
        return x;
      }
    }
  } else if (list_p (Form)) {
    var FName = car (Form);
    var Args = cdr (Form);
    switch (FName) {
      // ------------------------------------------------------------
      // Specials
      // ------------------------------------------------------------
    case "define":
      var Name = car (Args);
      var Value = car (cdr (Args));
      env_add_binding (Name, evaluate (Value, Env), Env);
      return true;
      break;
    case "lambda":
      var LambdaList = car (Args);
      var Body = cdr (Args);
      return make_function (LambdaList, Body, Env);
    case "if":
      var TestVal = evaluate (car (Args), Env);
      if (TestVal) {
        return evaluate (cadr (Args), Env);
      } else if (null_p (cdr (cdr (Args)))) {
        return false;
      } else {
        return evaluate (car (cdr (cdr (Args))), Env);
      }
      return evaluate (car (Args), Env) && evaluate (cadr (Args), Env);
    case "quote":
      return car (Args);
    case "quasiquote":
      return eval_quasiquote (car (Args), Env);
    case "defmacro":
      var Name = car (Args);
      var Body = cadr (Args);
      env_add_binding (Name, evaluate (Body, Env), MACRO_ENV);
      return true;
    case "begin":
      return evaluate_sequence (Args, Env);
    case "list":
      return evaluate_each (Args, Env);
    default:
      var Macro = env_lookup (FName, MACRO_ENV);
      if (Macro != NOT_FOUND) {
        var Expansion = expand_macro (Macro, Args);
        return evaluate (Expansion, Env);
      }
      else {
        var Fun = evaluate (FName, Env);
        if (builtin_p (Fun)) {
          return Fun.body (evaluate_each (Args, Env));
        }
        else {
          return apply_fun (Fun, Args, Env);
        }
      }
    }
  }

}

function eval_quasiquote (Form, Env) {
  if (null_p (Form)) {
    return nil;
  } else if (cons_p (Form)) {
    var Head = car (Form);
    var Tail = cdr (Form);
    if (cons_p (Head)) {
      var Head2 = car (Head);
      var Tail2 = cdr (Head);
      if (Head2 == "unquote") {
        return cons (evaluate (car (Tail2), Env),
                     eval_quasiquote (Tail, Env));
      } else if (Head2 == "unquote-splicing") {
        return list_append (evaluate (car (Tail2), Env),
                            eval_quasiquote (Tail, Env));
      } else {
        return cons (eval_quasiquote (Head, Env), eval_quasiquote (Tail, Env));
      }
    } else {
      return cons (eval_quasiquote (Head, Env), eval_quasiquote (Tail, Env));
    }
  } else {
    return Form;
  }
}

function evaluate_each (Forms, Env) {
  if (null_p (Forms)) {
    return nil;
  } else {
    return cons (evaluate (car (Forms), Env),
                 evaluate_each (cdr (Forms), Env));
  }
}

function evaluate_sequence (Forms, Env) {
  if (null_p (cdr (Forms))) {
    return evaluate (car (Forms), Env);
  } else {
    evaluate (car (Forms), Env);
    return evaluate_sequence (cdr (Forms), Env);
  }
}

// NASTY BUG:
// Macros are expanded in here, even if they're inside quotes.
function analyse (Sexp) {
  if (null_p (Sexp)) {
    return nil;
  } else if (cons_p (Sexp)) {
    var acc = nil;
    var input = Sexp;
    while (! null_p (input)) {
      var Head = car (input);
      var Tail = cdr (input);
      var rule = assoc (Head, ANALYSIS_ALIST);
      if (rule) {
        var expansion = cdr (rule);
        var TailA = analyse (Tail);
        return list_append (reverse (acc),
                            cons (cons (expansion, cons (car (TailA), nil)),
                                  cdr (TailA)));
      } else { // no expansion
        if (cons_p (Head)) {
          acc = cons (analyse (Head), acc);
        } else {
          acc = cons (Head, acc);
        }
        input = Tail;
      }
    }
    return reverse (acc);
  } else {
    return Sexp;
  }
}

function expand_macro (Fun, Args) {
  var NewEnv = env_extend (Fun.args, Args, Fun.env);
  return evaluate_sequence (Fun.body, NewEnv);
}

function apply_fun (Fun, Args, Env) {
  if (function_p (Fun)) {
    var NewEnv = env_extend (Fun.args, evaluate_each (Args, Env), Fun.env);
    return evaluate_sequence (Fun.body, NewEnv);
  } else if (special_p (Fun)) {
    var NewEnv = env_extend (Fun.args, Args, Env);
    return evaluate_sequence (Fun.body, NewEnv);
  }
}

function make_special (Name, Args, Body) {
  return {type:"special", name:Name, args:Args, body:Body};
}

function special_p (Obj) {
  return (object_p (Obj)) && (Obj.type == "special");
}

function make_function (Args, Body, Env) {
  var Fn = {type:"function", args:Args, body:Body, env:Env};
  Fn.toString = function () { return "#{function args=" + this.args + "}"; };
  return Fn;
}

function function_p (Obj) {
  return (object_p (Obj)) && (Obj.type == "function");
}

// A builtin is a javascript function that takes an evaluated argument
// list.
function make_builtin (Name, Func) {
  return {type:"builtin", name:Name, body:Func}
}

function builtin_p (Obj) {
  return (object_p (Obj)) && (Obj.type == "builtin");
}

// ----------------------------------------------------------------------
// Environments

function make_env (Parent) {
  var env = {parent:Parent, bindings:nil};
  env.toString = function() { return "#{env bindings="+this.bindings+"}"; }
  return env;
}

// destructive
function env_add_binding (name, value, env) {
  env.bindings = aset(name, value, env.bindings);
}

// Lookup the alist cell of a binding
function env_lookup (name, env) {
  var x = assoc (name, env.bindings);
  if (x == false) {
    if (null_p (env.parent)) {
      return NOT_FOUND;
    } else {
      return env_lookup (name, env.parent);
    }
  } else {
    return cdr (x);
  }
}

function env_extend (Names, Values, Env) {
  var NewEnv = make_env (Env);
  if (symbol_p (Names)) {       /* (lambda symbol . body) */
    env_add_binding (Names, Values, Env);
  } else {                      /* (lambda (symbol ...) . body) */
    env_extend1 (Names, Values, NewEnv);
  }
  return NewEnv;
}

function env_extend1 (Names, Values, Env) {
  if (null_p (Names)) {
    return true;
  } else if (car (Names) == ".") {
    env_add_binding (cadr (Names), Values, Env);
    return true;
  } else {
    env_add_binding (car (Names), car (Values), Env);
    return env_extend1 (cdr (Names), cdr (Values), Env);
  }
}

// ----------------------------------------------------------------------
// association lists

function assoc (name, alist) {
  if (null_p (alist)) {
    return false;
  } else {
    var cell = car (alist);
    if (car (cell) == name) {
      return cell;
    } else {
      return assoc (name, cdr (alist));
    }
  }
}

function aremove (name, alist) {
  if (null_p (alist)) {
    return nil;
  } else {
    var cell = car (alist);
    if (car (cell) == name) {
      return cdr (alist);
    } else {
      return cons (car (alist), aremove (name, cdr (alist)));
    }
  }
}

function aset (name, value, alist) {
  return acons (name, value, aremove (name, alist));
}

function acons (name, value, alist) {
  return cons (cons (name, value), alist);
}

// ----------------------------------------------------------------------
// Builtin functions
// ----------------------------------------------------------------------

// (cons a b)
function bi_cons (Args) {
  return cons (car (Args), cadr (Args));
}

// (car x)
function bi_car (Args) {
  return car (car (Args));
}

// (cdr x)
function bi_cdr (Args) {
  return cdr (car (Args));
}

// (pair? x)
function bi_pair_p (Args) {
  return cons_p (car (Args));
}

// (list? x)
function bi_list_p (Args) {
  return list_p (car (Args));
}

// (symbol? x)
function bi_symbol_p (Args) {
  return symbol_p (car (Args));
}

// (number? x)
function bi_number_p (Args) {
  return number_p (car (Args));
}

// (string? x)
function bi_string_p (Args) {
  return string_p (car (Args));
}

// (eq? a b)
function bi_eq_p (Args) {
  return car (Args) == cadr (Args);
}

// (equal? a b)
function bi_equal_p (Args) {
  // how to implement?
  return bi_eq_p(Args);
}

// (+ x y)
function bi_plus (Args) {
  return car (Args) + cadr (Args);
}

// (- x y)
function bi_minus (Args) {
  return car (Args) - cadr (Args);
}

// (/ x y)
function bi_divide (Args) {
  return car (Args) / cadr (Args);
}

// (* x y)
function bi_times (Args) {
  return car (Args) * cadr (Args);
}

// (null? obj)
function bi_nullp (Args) {
  return null_p (car (Args));
}

// (set-cookie name value)
function bi_set_cookie (Args) {
  setCookie(car (Args), cadr (Args));
  return true;
}

// (get-cookie name)
function bi_get_cookie (Args) {
  return getCookie (car (Args));
}

// (string-append . strings)
function bi_string_append (Args) {
  if (null_p (Args)) {
    return make_string("");
  } else {
    return string_concat(car (Args), bi_string_append (cdr (Args)));
  }
}

function string_concat (A, B) {
  return make_string (A.body + B.body);
}

function bi_symbol_to_string (Args) {
  return make_string (car (Args));
}

function bi_to_string (Args) {
  return make_string (to_string (car (Args)));
}

function bi_display (Args) {
  document.write (car (Args));
}

// (print-string string)
function bi_print_string (Args) {
  document.write (car (Args).body);
}

function escapify (str) {
  str = str.replace(/</g, "&lt;");
  str = str.replace(/>/g, "&gt;");
  return str;
}

function add_builtin (Name, FuncName) {
  var FBody = "return "+FuncName+"(argument);";
  var bi = make_builtin (Name, new Function ("argument", FBody));
  env_add_binding (Name, bi, TOP_ENV);
}

// Cookie access code snipped from the web
// name - name of the cookie
// value - value of the cookie
// [expires] - expiration date of the cookie (defaults to end of
//             current session)
// [path] - path for which the cookie is valid (defaults to path
//          of calling document)
// [domain] - domain for which the cookie is valid (defaults to
//            domain of calling document)
// [secure] - Boolean value indicating if the cookie transmission
//            requires a secure transmission
// * an argument defaults when it is assigned null as a placeholder
// * a null placeholder is not required for trailing omitted arguments
function setCookie(name, value, expires, path, domain, secure) {
  var curCookie = name + "=" + escape(value) +
    ((expires) ? "; expires=" + expires.toGMTString() : "") +
    ((path) ? "; path=" + path : "") +
    ((domain) ? "; domain=" + domain : "") +
    ((secure) ? "; secure" : "");
  document.cookie = curCookie;
}

// name - name of the desired cookie
// * return string containing value of specified cookie or null if
//   cookie does not exist
function getCookie(name) {
  var dc = document.cookie;
  var prefix = name + "=";
  var begin = dc.indexOf("; " + prefix);
  if (begin == -1) {
    begin = dc.indexOf(prefix);
    if (begin != 0) return null;
  } else
    begin += 2;
  var end = document.cookie.indexOf(";", begin);
  if (end == -1)
    end = dc.length;
  return unescape(dc.substring(begin + prefix.length, end));
}

// name - name of the cookie
// [path] - path of the cookie (must be same as path used to create cookie)
// [domain] - domain of the cookie (must be same as domain used to create
//            cookie)
// * path and domain default if assigned null or omitted if no explicit
//   argument proceeds
function deleteCookie(name, path, domain) {
  if (getCookie(name)) {
    document.cookie = name + "=" + 
      ((path) ? "; path=" + path : "") +
      ((domain) ? "; domain=" + domain : "") +
      "; expires=Thu, 01-Jan-70 00:00:01 GMT";
  }
}

// ----------------------------------------------------------------------
// API functions
// ----------------------------------------------------------------------

// Write the literal expression and its evaluated result into the
// document.
function show_expr (expr) {
  //document.write (expr + " => " + escapify (interpret (expr)) + "<br>");
  interpret (expr);
}

function show_parse (expr) {
  document.write (expr + " =parse=> " + to_string (parse_string (expr))
                  + "<br>");
}

function show_analysis (expr) {
  document.write (expr + "=analyse=> " +
                  to_string (analyse (parse_string (expr))) +
                  "<br>");
}

function show_tokens (expr) {
  document.write (expr + "=tokenise=> " + tokenise (expr) + "<br>");
}

// ----------------------------------------------------------------------
// Global variables and initialisation
// ----------------------------------------------------------------------

TOP_ENV = make_env (nil);
MACRO_ENV = make_env (nil);

// constant for values that aren't found
NOT_FOUND = null;

// If we don't limit this, we crash the browser
MAX_EVAL_DEPTH = 1000;

ANALYSIS_ALIST = nil;
function add_analysis_expansion (Symbol, Name) {
  ANALYSIS_ALIST = aset (Symbol, Name, ANALYSIS_ALIST);
}

add_analysis_expansion ("'", "quote");
add_analysis_expansion ("`", "quasiquote");
add_analysis_expansion (",", "unquote");
add_analysis_expansion (",@", "unquote-splicing");

add_builtin ("cons", "bi_cons");
add_builtin ("car", "bi_car");
add_builtin ("cdr", "bi_cdr");
add_builtin ("pair?", "bi_pair_p");
add_builtin ("list?", "bi_list_p");
add_builtin ("symbol?", "bi_symbol_p");
add_builtin ("string?", "bi_string_p");
add_builtin ("number?", "bi_number_p")
add_builtin ("+", "bi_plus");
add_builtin ("-", "bi_minus");
add_builtin ("*", "bi_times");
add_builtin ("/", "bi_divide");
add_builtin ("null?", "bi_nullp");
add_builtin ("set-cookie!", "bi_set_cookie");
add_builtin ("get-cookie", "bi_get_cookie");
add_builtin ("string-append", "bi_string_append");
add_builtin ("symbol->string", "bi_symbol_to_string");
add_builtin ("obj->string", "bi_to_string");
add_builtin ("display", "bi_display");
add_builtin ("print-string", "bi_print_string");
add_builtin ("=", "bi_eq_p");   /* `=' same as `eq?' here */
add_builtin ("eq?", "bi_eq_p");
add_builtin ("equal?", "bi_equal_p");
env_add_binding ("nil", nil, TOP_ENV);

/*  show_expr ("\"foo\""); */
/*  show_expr ("(string-append \"foo\" \"bar\")"); */
/*  show_expr ("(obj->string '(1 2 (3)))"); */