php/step6_file.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->value);
  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]->value, $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]->value, MAL_EVAL($a1[$i+1], $let_env));
  58         }
  59         return MAL_EVAL($ast[2], $let_env);
  60     case "do":
  61         eval_ast($ast->slice(1, -1), $env);
  62         $ast = $ast[count($ast)-1];
  63         break;
  64     case "if":
  65         $cond = MAL_EVAL($ast[1], $env);
  66         if ($cond === NULL || $cond === false) {
  67             if (count($ast) === 4) { $ast = $ast[3]; }
  68             else                   { $ast = NULL; }
  69         } else {
  70             $ast = $ast[2];
  71         }
  72         break;
  73     case "fn*":
  74         return _function('MAL_EVAL', 'native',
  75                          _hash_map('exp', $ast[2],
  76                                    'env', $env,
  77                                    'params', $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->meta['exp'];
  84             $env = new Env($f->meta['env'], $f->meta['params'], $args);
  85         } else {
  86             return $f->apply($args);
  87         }
  88     }
  89
  90     }
  91 }
  92
  93 // print
  94 function MAL_PRINT($exp) {
  95     return _pr_str($exp, True) . "\n";
  96 }
  97
  98 // repl
  99 $repl_env = new Env(NULL);
 100 function rep($str) {
 101     global $repl_env;
 102     return MAL_PRINT(MAL_EVAL(READ($str), $repl_env));
 103 }
 104 function _ref($k, $v) {
 105     global $repl_env;
 106     $repl_env->set($k, _function($v));
 107 }
 108 // Import core functions
 109 foreach ($core_ns as $k=>$v) { _ref($k, $v); }
 110
 111 _ref('read-string', 'read_str');
 112 _ref('eval', function($ast) {
 113     global $repl_env; return MAL_EVAL($ast, $repl_env);
 114 });
 115 _ref('slurp', function($f) {
 116     return file_get_contents($f);
 117 });
 118
 119 // Defined using the language itself
 120 rep("(def! not (fn* (a) (if a false true)))");
 121 rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
 122
 123 if (count($argv) > 1) {
 124     for ($i=1; $i < count($argv); $i++) {
 125         rep('(load-file "' . $argv[$i] . '")');
 126     }
 127 } else {
 128     do {
 129         try {
 130             $line = mal_readline("user> ");
 131             if ($line === NULL) { break; }
 132             if ($line !== "") {
 133                 print(rep($line));
 134             }
 135         } catch (BlankException $e) {
 136             continue;
 137         } catch (Exception $e) {
 138             echo "Error: " . $e->getMessage() . "\n";
 139             echo $e->getTraceAsString() . "\n";
 140         }
 141     } while (true);
 142 }
 143
 144 ?>