PHPで書いたLISP級マクロ付きインタプリタ

LISP級マクロ付きのインタプリタをPHPで書いてみました。
作る順番は、だいたい決まってきて、必要ない機能はある程度削られてますけど、
一番本質的な部分はつかめると思います。

以下ソースです。

<?php
class Symbol {
  var $str;
  private function __construct($str) {
    $this->str = $str;
  }
  static function intern($str) {
    static $arr = array();
    if(isset($arr[$str])) return $arr[$str];
    return $arr[$str] = new Symbol($str);
  }
  public function __toString() {
    return "'".$this->str;
  }
}

class Lexer {

  function __construct($src) {
    $src = str_replace("\r\n", "\v", $src);
    $src = str_replace("\r", "\v", $src);
    $src = str_replace("\n", "\v", $src);
    $this->src = $src;
  }

  function lex() {
    $m = array();
    if (preg_match("/^[\\v\\t ]*([0-9]+)(.*$)/", $this->src, $m)>0) {
      $this->src = $m[2];
      return $m[1]+0;
    }
    if (preg_match("/^[\\v\\t ]*[\\v][\\v\\t ]*([(\\[{])(.*$)/", $this->src, $m)>0) {
      $this->src = $m[2];
      return "n" . $m[1];
    }
    if (preg_match("/^[\\v\\t ]*'([a-zA-Z_][a-zA-Z_0-9]*)(.*$)/", $this->src, $m)>0) {
      $this->src = $m[2];
      return Symbol::intern($m[1]);
    }
    if (preg_match("/^[\\v\\t ]*([()\\[\\]{},;]|[+*\\-\\/=<>]+|[a-zA-Z_][a-zA-Z_0-9]*)(.*$)/", $this->src, $m)>0) {
      $this->src = $m[2];
      return $m[1];
    }
    return false;
  }

  function tokens() {
    $ts = array();
    while (($token = $this->lex()) !== false) {
      $ts[] = $token;
    }
    return $ts;
  }

}

class Parser {
  function __construct() {
    $this->opLs = array(">"=>190, "<"=>190, "+" => 10, "-" => 10, "*" => 20, "/" => 20, "," => 2, "else" => 1);
    $this->opRs = array("=" => 5);
    $this->opPs = array("(" => ")", "[" => "]", "{" => "}", "n(" => ")", "n[" => "]", "n{"=>"}");
    $this->opMs = array("(" => 200, "[" => 200, "{" => 200);
    $this->opSs = array("fun" => "(", "if" => "(", "mac" => "(");
    $this->opBs = array("++"=> 30, ";" => 1);
  }

  function parse($src) {
    $lexer = new Lexer($src);
    $this->tokens = $lexer->tokens();
    $t = $this->expn(0);
    while (count($this->tokens) > 0) {
      $t = array("@", $t, $this->expn(0));
    }
    return $t;
  }

  function expn($p) {
    if (in_array($this->tokens[0], $this->opPs, true)) {
      return "vid";
    }
    $t = array_shift($this->tokens);
    if (isset($this->opBs[$this->tokens[0]]) && ($tagp = $this->opBs[$this->tokens[0]]) >= $p) {
        $op = array_shift($this->tokens);
        $t = array("B". $op, $t);
        $p = $tagp;
    } elseif ($t instanceof Symbol) {
    } elseif (isset($this->opSs[$t]) && $this->opSs[$t] == $this->tokens[0]) {
      $op = array_shift($this->tokens);
      if ($op[0] == "n") $op = substr($op, 1); 
      $e = $this->expn(0);
      if (($op2 = array_shift($this->tokens)) != $this->opPs[$op]) {
        throw new Exception("error $op2 ". $this->opPs[$op]);
      }
      $t = array("S" . $t . $op . $op2, $e, $this->expn(0));
    } elseif (isset($this->opPs[$t])) {
      if ($t[0] == "n") $t = substr($t, 1); 
      $t2 = $this->expn(0);
      if(($t3 = array_shift($this->tokens)) != $this->opPs[$t]) {
        throw "error";
      }
      $t = array("P" . $t . $t3, $t2);
    }

    while (true) {
      if (isset($this->opMs[$this->tokens[0]]) && ($tagp = $this->opMs[$this->tokens[0]]) >= $p) {
        $op = array_shift($this->tokens);
        $e = $this->expn(0);
        if(($op2 = array_shift($this->tokens)) != $this->opPs[$op]) {
          throw new Exception("error");
        }
        $t = array("M" . $op . $op2, $t, $e);
        
      } elseif(isset($this->opLs[$this->tokens[0]]) && ($tagp = $this->opLs[$this->tokens[0]]) > $p) {
        $op = array_shift($this->tokens);
        $t = array("L".$op, $t, $this->expn($tagp));
      } elseif(isset($this->opRs[$this->tokens[0]]) && ($tagp = $this->opRs[$this->tokens[0]]) >= $p) {
        $op = array_shift($this->tokens);
        $t = array("R".$op, $t, $this->expn($tagp));
      } else {
        return $t;
      }
    }
  }

}

class Env {
  var $env;

  function __construct($parent = null) {
    $this->env = array();
    if($parent != null) $this->env["parent"] = $parent;
  }

  function __isset($name) {
    return isset($this->env[$name]);
  }

  function __get($name) {
    if(isset($this->env[$name])) return $this->env[$name];
    if(isset($this->env["parent"])) return $this->env["parent"]->$name;
    return "nil";
  }
  
  function __set($name, $value) {
    $rc = $this->put($this->env, $name, $value);
    if ($rc === false) {
      $this->env[$name] = $value;
      return $value;
    } else {
      return $rc;
    }
  }

  function put(&$env, $name, $value) {
    if (isset($env[$name])) {
      $env[$name] = $value;
      return $value;
    } elseif (isset($env["parent"])) {
      return $this->put($env["parent"]->env, $name, $value);
    } else {
      return false;
    }
  }

}
class Calc {
  function __construct() {
    $this->parser = new Parser();
  }

  function evalute($src) {
    $exp = $this->parser->parse($src);
    var_export($exp); echo "\n";

    $this->env = new Env();
    $this->env->macros = array();
    $exp = $this->macroExpand($exp, $this->env->macros);
    var_export($exp); echo "\n";
    return $this->execute($exp);
  }
  function macroExpand($a, &$e) {
    foreach($e as &$obj) {
      $this->env = new Env($this->env);
      $rc = $this->macroMatch($obj[1], $a);
      if ($rc) {
        $r = $this->execute($obj[2]);
        $this->env = $this->env->parent;
        return $r;
      }
      $this->env = $this->env->parent;
    }
    if (is_array($a)) {
      if ($a[0] == "Smac()") {
        $e[] = $a;
        return "nil";
      } elseif ($a[0] == "M()" && $a[1] == "add" && is_array($a[2]) && $a[2][0] == "L,") {
        return array("L+", $this->macroExpand($a[2][1], $e), $this->macroExpand($a[2][2], $e));
      } else {
        return array($a[0], $this->macroExpand($a[1], $e), $this->macroExpand($a[2], $e));
      }
    } else {
      return $a;
    }
  }

  function macroMatch ($a, $b) {
    if(is_array($a)) {
        return $a[0]==$b[0] && $this->macroMatch($a[1],$b[1]) && $this->macroMatch($a[2], $b[2]);
    } elseif ($a instanceof Symbol) {
      $name = $a->str;
      $this->env->$name = $b;
      return true;
    } else {
      return $a == $b;
    }
  }

  function execute($exp) {
//    var_dump($exp);
    if (is_array($exp)) {
      switch ($exp[0]) {
      case "L+": return $this->execute($exp[1]) + $this->execute($exp[2]);
      case "L-": return $this->execute($exp[1]) - $this->execute($exp[2]);
      case "L*": return $this->execute($exp[1]) * $this->execute($exp[2]);
      case "L/": return $this->execute($exp[1]) / $this->execute($exp[2]);
      case "L<": return $this->execute($exp[1]) < $this->execute($exp[2]);
      case "L>": return $this->execute($exp[1]) > $this->execute($exp[2]);
      case "B;": return $this->execute($exp[1]);
      case "B++": $name = $exp[1]; $dt = $this->env->$name; $this->env->$name = $dt + 1; return $dt;
      case "R=": $name = $exp[1]; return $this->env->$name = $this->execute($exp[2]);
      case "@": $this->execute($exp[1]); return $this->execute($exp[2]);
      case "P()": return $this->execute($exp[1]);
      case "P{}": return $this->execute($exp[1]);
      case "P[]": return $this->execute($exp[1]);
      case "Sfun()": return array("fun", $exp[1], $exp[2], $this->env);
      case "fun"; return $exp;
      case "Sif()":
        $l1 = $this->execute($exp[1]);
        if (is_array($exp[2]) && $exp[2][0] == "Lelse") {
          if ($l1 != 0) {
            return $this->execute($exp[2][1]);
          } else {
            return $this->execute($exp[2][2]);
          }
        } else {
          if (l1 != 0) {
            return $this->execute($exp[2]);
          } else {
            return "nil";
          }
        }
      case "M()":
        switch ($exp[1]) {
        case "p": $rc = $this->execute($exp[2]); var_dump($rc); return $rc;
        default:
          $name = $exp[1];
          if (!isset($this->env->$name)) {
            var_dump($this->env);
            throw new Exception("error ".$exp[1]);
          }
          $fun = $this->env->$name;
          $back = $this->env;
          $this->env = new Env();
          $this->bind($fun[1], $exp[2]);
          $this->env->parent = $fun[3];
          $a = $this->execute($fun[2]);
          $this->env = $back;
          return $a;

        }
      default:
        return $this->execute($exp[1]);
      }
    } elseif(is_string($exp)) {
      return $this->env->$exp;
    } else {
      return $exp;
    }
  }

  function bind($p, $l) {
    if(is_string($p)) {
      $this->env->$p = $l;
    } elseif(is_array($p)) {
      
      if(count($p) != 3) throw new Exception("error");
      if(count($l) != 3) throw new Exception("error");
      if($p[0] != "L,") throw new Exception("error");
      if($l[0] != "L,") throw new Exception("error");
      $this->bind($p[1], $l[1]);
      $this->bind($p[2], $l[2]);
    } else {
      throw new Exception("error");
    }
  }

}
$calc = new Calc();
echo $calc->evalute("mac(mul('a,'b))a*b\nmul(2,3)");