syntax.js

(function(){
//
// Syntax
//
BiwaScheme.Syntax = BiwaScheme.Class.create({
  initialize: function(sname, func){
    this.sname = sname;
    this.func = func;
  },
  transform: function(x){
    if (!this.func){
      throw new BiwaScheme.Bug("sorry, syntax "+this.sname+
                               " is a pseudo syntax now");
    }
    return this.func(x);
  },
  inspect: function(){
    return "#<Syntax " + this.sname +">";
  }
});

// A built-in syntax did not have associated Syntax object.
// Following code installed dummy Syntax objects to built-in syntax.
BiwaScheme.CoreEnv["define"] = new BiwaScheme.Syntax("define");
BiwaScheme.CoreEnv["begin"]  = new BiwaScheme.Syntax("begin");
BiwaScheme.CoreEnv["quote"]  = new BiwaScheme.Syntax("quote");
BiwaScheme.CoreEnv["lambda"] = new BiwaScheme.Syntax("lambda");
BiwaScheme.CoreEnv["if"]     = new BiwaScheme.Syntax("if");
BiwaScheme.CoreEnv["set!"]   = new BiwaScheme.Syntax("set!");

//
// syntax-case
//

BiwaScheme.Syntax.SyntaxObject = BiwaScheme.Class.create({
  initialize: function(expr, wrap){
    this.expr = expr;
    this.wrap = wrap;
  },

  // Return the label corresponding to this identifier
  getLabel: function() {
    BiwaScheme.assert(this.expr instanceof BiwaScheme.Symbol,
                      "called getLabel on non-identifier SO");
    var sym = this.expr;
    var marks = this.wrap.marks();

    for (var i=0; i<this.wrap.markSubsts.length; i++) {
      var ms = this.wrap.markSubsts[i];
      if (ms instanceof Mark) {
        marks = _.rest(marks);
      }
      else {
        var subst = ms;
        if (subst.sym === sym && Mark.isSameMarks(subst.marks, marks)) {
          return subst.label;
        }
      }
    }
    throw new BiwaScheme.Error("undefined identifier: "+sym.name);
  },
  
  // syntax->datum
  strip: function() {
    // I'm not sure this definition is correct
    return this.expr;
  }
});

_.extend(BiwaScheme.Syntax.SyntaxObject, {
  // Return a SyntaxObject with a mark
  // x : SyntaxObject or scheme expr
  addMark: function(x, mark) {
    if (x instanceof SyntaxObject) {
      return new SyntaxObject(x.expr, x.wrap.addMark(mark));
    }
    else {
      return new SyntaxObject(x, new Wrap([mark]));
    }
  },

  // Return a SyntaxObject with a subst
  // id : identifier(SyntaxObject with Symbol)
  // label: Label
  // x : SyntaxObject or scheme expr
  addSubst: function(id, label, x) {
    var subst = new Subst(id.expr, id.wrap.marks(), label);
    if (x instanceof SyntaxObject) {
      return new SyntaxObject(x.expr, x.wrap.addSubst(subst));
    }
    else {
      return new SyntaxObject(x, new Wrap([subst]));
    }
  }
}

BiwaScheme.isIdentifier = function(x) {
  return (x instanceof SyntaxObject) &&
         (x.expr instanceof Symbol);
};

BiwaScheme.Syntax.Mark = BiwaScheme.Class.create({
  initialize: function(){
    this.n = (BiwaScheme.Syntax.Mark.n++);
  },
  inspect: function(){
    return "#<Mark "+this.n+">";
  }
});
BiwaScheme.Syntax.Mark.n = 0;
BiwaScheme.Syntax.Mark.TopMark = new BiwaScheme.Syntax.Mark();

// Return true if `this.marks` and `marks` are the same (ordered) list of Marks 
// - marks1, marks2: Array<Mark>
BiwaScheme.Syntax.Mark.isSameMarks = function(marks1, marks2) {
  var markPairs = _.zip(marks1, marks2);
  return _.all(markPairs, function(mm) {
    return mm[0] === mm[1];
  });
}

BiwaScheme.Syntax.Label = BiwaScheme.Class.create({
  initialize: function(){
    this.n = (BiwaScheme.Syntax.Label.n++);
  },
  inspect: function(){
    return "#<Label "+this.n+">";
  }
});
BiwaScheme.Syntax.Label.n = 0;

BiwaScheme.Syntax.Subst = BiwaScheme.Class.create({
  initialize: function(sym, marks, label){
    this.sym = sym;     // Symbol
    this.marks = marks; // Array<Mark>
    this.label = label; // Label
  },

  inspect: function(){
    return "#<Subst>";
  }
});

BiwaScheme.Syntax.Wrap = BiwaScheme.Class.create({
  initialize: function(markSubsts){
    this.markSubsts = markSubsts;   // Array<Mark|Subst>
  },

  // Return an array of the marks
  marks: function() {
    return _.filter(this.markSubsts,
                    function(x){ return x instanceof Mark });
  },

  // Return a new Wrap with `mark`
  addMark: function(mark) {
    return new Wrap([mark]).join(this);
  },

  // Return a new Wrap with `subst`
  addSubst: function(subst) {
    return new Wrap([subst].concat(this.markSubsts));
  },

  // Return a new wrap combination of this and other
  // Note that consecutive same marks cancels each other
  join: function(other) {
    var a1 = this.markSubsts,
        a2 = other.markSubsts;
    if (this.markSubsts.length == 0 || other.markSubsts.length == 0) {
      return a1.concat(a2);
    }

    var x1 = _.last(this.markSubsts),
        x2 = _.first(other.markSubsts);
    if (x1 instanceof BiwaScheme.Syntax.Mark && x1 === x2) {
      a1 = _.initial(a1);  // Omit x1 and x2 from the result
      a2 = _.rest(a2);
    }
    return a1.concat(a2);
  },

  // Return true if this wrap has TopMark
  isTopMarked: function() {
    return _.some(this.markSubsts, function(ms) {
      return ms[0] === BiwaScheme.Syntax.Mark.TopMark;
    });
  },

  inspect: function() {
    return "#<Wrap>";
  }
});

BiwaScheme.Syntax.Binding = BiwaScheme.Class.create({
  initialize: function(type, value){
    this.type = type;   // either of "macro" "lexical" "core"
    this.value = value;
  },

  inspect: function(){
    return "#<Binding("+this.type+")>";
  }
});

BiwaScheme.Syntax.Env = BiwaScheme.Class.create({
  initialize: function(/*hash*/){
    this.hash = arguments[0] || {};  // Hash<Label, Binding>
  },

  set: function(k, v) {
    this.hash[k] = v;
  },

  // Return a new Env adding (k, v) to this
  extend: function(k, v) {
    var newHash = {};
    _.extend(newHash, this.hash);
    return new Env(newHash);
  },

  hasKey: function(k) {
    return this.hash.hasOwnProperty(k);
  },

  get: function(k) {
    return this.hasKey(k) ? this.hash[k] : null;
  },

  // - id: identifier SO
  bindingOfId: function(id) {
    var binding = this.get(id.getLabel());
    if (!binding) {
      throw new BiwaScheme.Error("displaced lexical: "+id.expr.name);
    }
    return binding;
  },

  inspect: function(){
    return "#<Env>";
  }
});

BiwaScheme.Syntax.INITIAL_ENV_ITEMS = [
  ["quote", "core", function(so, env, metaEnv){
    var x = so.expr;
    if (!(x.cdr instanceof BiwaScheme.Pair)) throw new Error("quote: missing argument");
    if (x.cdr.cdr !== BiwaScheme.nil) throw new Error("quote: too many arguments");
    return List(Sym("quote"), x.cdr.car);
  }],

  ["if", "core", function(so, env, metaEnv){
    var x = so.expr;
    if (!(x.cdr instanceof BiwaScheme.Pair)) throw new Error("if: missing argument");
    var argExprs = x.cdr.to_array();
    if (argExprs.length < 2) throw new Error("if: missing then clause");
    if (argExprs.length > 3) throw new Error("if: too many clauses");

    var expArgs = argExprs.map(function(expr){
      TODO
    });
    
    return List.apply(null, [Sym("if")].concat(expArgs));
  }],

  ["lambda", "core", function(so, env, metaEnv){
    var exprs = so.expr.to_array();
    if (exprs.length < 3) throw new Error("malformed lambda");
    var paramList = exprs[0];
    var bodyExprs = _.rest(exprs);

    // TODO: support arity != 1
    //if(!(paramList instanceof Pair)) throw new Error("lambda:  ")
    var newVar = Syntax.genVar(paramList.car.name);

    var label = new Label();
    var binding = new Binding("lexical", newVar);
    var newEnv = env.extend(label, binding);

    var newBodyExprs = bodyExprs.map(function(bodyExpr){
      var subst =
      SyntaxObject.addSubst( // TODO: #'var
                            label,
                            bodyExpr)
      return Expander._exp(subst, newEnv, metaEnv);
    });

    return List.apply(null, [Sym("lambda"), List(newParam)].concat(newBodyExprs));
  }],

  // TODO: パターン変数を展開する処理がいりそう
  ["syntax", "core", function(so, env, metaEnv){
    var x = so.expr;
    if (!(x.cdr instanceof BiwaScheme.Pair)) throw new Error("quote: missing argument");
    if (x.cdr.cdr !== BiwaScheme.nil) throw new Error("quote: too many arguments");
    var target = x.cdr.car;
    var so = new BiwaScheme.Syntax.SyntaxObject(target);
    return List(Sym("quote"), so);
  }],

  ["let", "core", function(so, env, metaEnv){
    var x = so.expr;
    // (let ((a 1) (b 2)) (+ a b))
    // => ((lambda (a b) (+ a b)) 1 2)
    var name = null;
    if (x.cdr.car instanceof Symbol) {
      name = x.cdr.car;
      x = x.cdr;
    }
    var binds = x.cdr.car, body = x.cdr.cdr;

    if((!(binds instanceof Pair)) && binds != BiwaScheme.nil){
      throw new Error("let: need a pair for bindings: got "+to_write(binds));
    }

    var vars = nil, vals = nil;
    for(var p=binds; p instanceof Pair; p=p.cdr){
      if(!(p.car instanceof Pair)){
        throw new Error("let: need a pair for bindings: got "+to_write(p.car));
      }
      vars = new Pair(p.car.car, vars);
      vals = new Pair(p.car.cdr.car, vals);
    }

    var lambda = null;
    if (name) {
      // (let loop ((a 1) (b 2)) body ..)
      //=> (letrec ((loop (lambda (a b) body ..))) (loop 1 2))
      vars = array_to_list(vars.to_array().reverse());
      vals = array_to_list(vals.to_array().reverse());

      var body_lambda = new Pair(Sym("lambda"), new Pair(vars, body));
      var init_call = new Pair(name, vals);

      lambda = List(Sym("letrec"),
                    new Pair(List(name, body_lambda), nil),
                    init_call);
    }
    else {
      lambda = new Pair(new Pair(Sym("lambda"),
                                 new Pair(vars, body)),
                        vals);
    }
    return lambda;
  }],

  ["swap!", "macro", function(so, env, metaEnv){
    // (swap! a b)
    // = (let ((temp #'a)) (set! #'a #'b) (set! b temp))
  }]
];
BiwaScheme.Syntax.InitialWrap = new BiwaScheme.Syntax.Wrap();
BiwaScheme.Syntax.InitialEnv = new BiwaScheme.Syntax.Env();
BiwaScheme.Syntax.INITIAL_ENV_ITEMS.forEach(function(item){
  var name = item[0], type = item[1], value = item[2];

  var label = new BiwaScheme.Syntax.Label();
  var binding = new BiwaScheme.Syntax.Binding(type, value)

  BiwaScheme.Syntax.InitialEnv.set(label, binding);
});

// Misc

_.extend(BiwaScheme.Syntax, {
  genVar: function(prefix){
    var n = (Syntax._genVar++);
    return new Symbol(prefix + "." + n);
  },
  _genVar: 0

  // free-identifier=?
  isFreeIdentifierEqual: function(id1, id2) {
    return id1.getLabel() === id2.getLabel();
  },

  // bound-identifier=?
  isBoundIdentifierEqual: function(id1, id2) {
    return id1.expr.name == id2.expr.name &&
           Mark.isSameMarks(id1.wrap.marks(), id2.wrap.marks());
  },

  // datum->syntax
  // templateId: Identifier to copy context
  // expr: Scheme expr
  datumToSyntax: function(templateId, expr) {
    return new SyntaxObject(expr, templateId.wrap);
  }
});

//
// Expander
//

BiwaScheme.Expander = {
  expand: function(expr) {
    var so = new SyntaxObject(expr, Syntax.InitialWrap),
        env = Syntax.InitialEnv,
        menv = Syntax.InitialEnv;
    return Syntax._exp(so, env, menv);
  },

  _exp: function(so, env, menv) {
    var expr = so.expr;
    if (expr instanceof BiwaScheme.Symbol) {
      // Variable reference or varref-like macro call
      var binding = env.bindingOfId(so);
      switch(binding.type) {
        case "macro":
          var newx = Syntax._expandMacro(binding.value, so);
          return Syntax._exp(newx, env, menv);
        case "lexical":
          return binding.value;
        default:
          throw new BiwaScheme.Error("invalid syntax: "+expr.name);
      }
    }
    else if (expr instanceof BiwaScheme.Pair) {
      if (expr.car instanceof BiwaScheme.Symbol) {
        // Funcion call or macro call
        var id = new SyntaxObject(expr.car, so.wrap);
        var binding = env.bindingOfId(id);
        switch(binding.type) {
          case "macro":
            var newx = Syntax._expandMacro(binding.value, so);
            return Syntax._exp(newx, env, menv);
          case "lexical":
            var argExprs = expr.cdr.to_array();
            var car = binding.value;
            var cdr = List.apply(null, Syntax._expandExprs(argExprs, env, menv));
            return new SyntaxObject(new Pair(car, cdr), so.wrap)
          case "core":
            return Syntax._expandCore(binding.value, so, env, menv);
          default:
            throw "must not happen"
        }
      }
      else {
        // ((func expr...) args...)
        var funExpr = expr.car;
        var argExprs = expr.cdr.to_array();
        var car = Syntax._exp(new SyntaxObject(e0, so.wrap), env, menv);
        var cdr = List.apply(null, Syntax._expandExprs(argExprs, env, menv));
        return new SyntaxObject(new Pair(car, cdr), so.wrap);
      }
    }
    else {
      // Constant
      var d = so.strip();
      if (!BiwaScheme.isSelfEvaluating(d)) {
        throw new Error("invalid syntax: "+BiwaScheme.to_write(d));
      }
      return d;
    }
  },
  
  _expandMacro: function(transformer, so) {
    var m = new Mark();
    // Call `addMark` before and after the transformation.
    // Only "new" code are left marked because same marks cancel each other.
    // TODO: transformerはどのようなオブジェクトにするか？
    // てかsyntax-case実装するならこのタイミングでtransformerを評価しないといけないので大変だな、、
    transformer.call(so.addMark(m)).addMark(m);
  },

  _expandCore: function(coreTrans, so, env, menv) {
    return new SyntaxObject(coreTrans(so, env, menv), so.wrap);
  },

  // - exprs: Array<SO>
  _expandExprs: function(exprs, env, menv) {
    return exprs.map(function(so) {
      return Syntax._exp(so, env, menv);
    });
  }
}

// Aliases for this file
var Syntax = BiwaScheme.Syntax,
    SyntaxObject = BiwaScheme.Syntax.SyntaxObject,
    Wrap = BiwaScheme.Syntax.Wrap,
    Mark = BiwaScheme.Syntax.Mark;

})();