php/step5_tco.php

   1 <?php
   2
   3 require_once 'readline.php';
   4 require_once 'types.php';
   5 require_once 'reader.php';
   6 require_once 'printer.php';
   7 require_once 'env.php';
   8 require_once 'core.php';
   9
  10 // read
  11 function READ($str) {
  12     return read_str($str);
  13 }
  14
  15 // eval
  16 function eval_ast($ast, $env) {
  17     if (_symbol_Q($ast)) {
  18         return $env->get($ast);
  19     } elseif (_sequential_Q($ast)) {
  20         if (_list_Q($ast)) {
  21             $el = _list();
  22         } else {
  23             $el = _vector();
  24         }
  25         foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); }
  26         return $el;
  27     } elseif (_hash_map_Q($ast)) {
  28         $new_hm = _hash_map();
  29         foreach (array_keys($ast->getArrayCopy()) as $key) {
  30             $new_hm[$key] = MAL_EVAL($ast[$key], $env);
  31         }
  32         return $new_hm;
  33     } else {
  34         return $ast;
  35     }
  36 }
  37
  38 function MAL_EVAL($ast, $env) {
  39     while (true) {
  40
  41     #echo "MAL_EVAL: " . _pr_str($ast) . "\n";
  42     if (!_list_Q($ast)) {
  43         return eval_ast($ast, $env);
  44     }
  45
  46     // apply list
  47     $a0 = $ast[0];
  48     $a0v = (_symbol_Q($a0) ? $a0->value : $a0);
  49     switch ($a0v) {
  50     case "def!":
  51         $res = MAL_EVAL($ast[2], $env);
  52         return $env->set($ast[1], $res);
  53     case "let*":
  54         $a1 = $ast[1];
  55         $let_env = new Env($env);
  56         for ($i=0; $i < count($a1); $i+=2) {
  57             $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env));
  58         }
  59         $ast = $ast[2];
  60         $env = $let_env;
  61         break; // Continue loop (TCO)
  62     case "do":
  63         eval_ast($ast->slice(1, -1), $env);
  64         $ast = $ast[count($ast)-1];
  65         break; // Continue loop (TCO)
  66     case "if":
  67         $cond = MAL_EVAL($ast[1], $env);
  68         if ($cond === NULL || $cond === false) {
  69             if (count($ast) === 4) { $ast = $ast[3]; }
  70             else                   { $ast = NULL; }
  71         } else {
  72             $ast = $ast[2];
  73         }
  74         break; // Continue loop (TCO)
  75     case "fn*":
  76         return _function('MAL_EVAL', 'native',
  77                          $ast[2], $env, $ast[1]);
  78     default:
  79         $el = eval_ast($ast, $env);
  80         $f = $el[0];
  81         $args = array_slice($el->getArrayCopy(), 1);
  82         if ($f->type === 'native') {
  83             $ast = $f->ast;
  84             $env = $f->gen_env($args);
  85             // Continue loop (TCO)
  86         } else {
  87             return $f->apply($args);
  88         }
  89     }
  90
  91     }
  92 }
  93
  94 // print
  95 function MAL_PRINT($exp) {
  96     return _pr_str($exp, True);
  97 }
  98
  99 // repl
 100 $repl_env = new Env(NULL);
 101 function rep($str) {
 102     global $repl_env;
 103     return MAL_PRINT(MAL_EVAL(READ($str), $repl_env));
 104 }
 105
 106 // core.php: defined using PHP
 107 foreach ($core_ns as $k=>$v) {
 108     $repl_env->set(_symbol($k), _function($v));
 109 }
 110
 111 // core.mal: defined using the language itself
 112 rep("(def! not (fn* (a) (if a false true)))");
 113
 114 // repl loop
 115 do {
 116     try {
 117         $line = mal_readline("user> ");
 118         if ($line === NULL) { break; }
 119         if ($line !== "") {
 120             print(rep($line) . "\n");
 121         }
 122     } catch (BlankException $e) {
 123         continue;
 124     } catch (Exception $e) {
 125         echo "Error: " . $e->getMessage() . "\n";
 126         echo $e->getTraceAsString() . "\n";
 127     }
 128 } while (true);
 129
 130 ?>