matlab/stepA_mal.m

   1 function stepA_mal(varargin), main(varargin), end
   2
   3 % read
   4 function ret = READ(str)
   5     ret = reader.read_str(str);
   6 end
   7
   8 % eval
   9 function ret = is_pair(ast)
  10     ret = type_utils.sequential_Q(ast) && length(ast) > 0;
  11 end
  12
  13 function ret = quasiquote(ast)
  14     if ~is_pair(ast)
  15         ret = types.List(types.Symbol('quote'), ast);
  16     elseif isa(ast.get(1),'types.Symbol') && ...
  17            strcmp(ast.get(1).name, 'unquote')
  18         ret = ast.get(2);
  19     elseif is_pair(ast.get(1)) && ...
  20            isa(ast.get(1).get(1),'types.Symbol') && ...
  21            strcmp(ast.get(1).get(1).name, 'splice-unquote')
  22         ret = types.List(types.Symbol('concat'), ...
  23                          ast.get(1).get(2), ...
  24                          quasiquote(ast.slice(2)));
  25     else
  26         ret = types.List(types.Symbol('cons'), ...
  27                          quasiquote(ast.get(1)), ...
  28                          quasiquote(ast.slice(2)));
  29     end
  30 end
  31
  32 function ret = is_macro_call(ast, env)
  33     if type_utils.list_Q(ast) && isa(ast.get(1), 'types.Symbol') && ...
  34        ~islogical(env.find(ast.get(1)))
  35         f = env.get(ast.get(1));
  36         ret = isa(f,'types.Function') && f.is_macro;
  37     else
  38         ret = false;
  39     end
  40 end
  41
  42 function ret = macroexpand(ast, env)
  43     while is_macro_call(ast, env)
  44         mac = env.get(ast.get(1));
  45         args = ast.slice(2);
  46         ast = mac.fn(args.data{:});
  47     end
  48     ret = ast;
  49 end
  50
  51 function ret = eval_ast(ast, env)
  52     switch class(ast)
  53     case 'types.Symbol'
  54         ret = env.get(ast);
  55     case 'types.List'
  56         ret = types.List();
  57         for i=1:length(ast)
  58             ret.append(EVAL(ast.get(i), env));
  59         end
  60     case 'types.Vector'
  61         ret = types.Vector();
  62         for i=1:length(ast)
  63             ret.append(EVAL(ast.get(i), env));
  64         end
  65     case 'types.HashMap'
  66         ret = types.HashMap();
  67         ks = ast.keys();
  68         for i=1:length(ks)
  69             k = ks{i};
  70             ret.set(EVAL(k, env), EVAL(ast.get(k), env));
  71         end
  72     otherwise
  73         ret = ast;
  74     end
  75 end
  76
  77 function ret = EVAL(ast, env)
  78   while true
  79     %fprintf('EVAL: %s\n', printer.pr_str(ast, true));
  80     if ~type_utils.list_Q(ast)
  81         ret = eval_ast(ast, env);
  82         return;
  83     end
  84
  85     % apply
  86     if length(ast) == 0
  87         ret = ast;
  88         return;
  89     end
  90     ast = macroexpand(ast, env);
  91     if ~type_utils.list_Q(ast)
  92         ret = eval_ast(ast, env);
  93         return;
  94     end
  95
  96     if isa(ast.get(1),'types.Symbol')
  97         a1sym = ast.get(1).name;
  98     else
  99         a1sym = '_@$fn$@_';
 100     end
 101     switch (a1sym)
 102     case 'def!'
 103         ret = env.set(ast.get(2), EVAL(ast.get(3), env));
 104         return;
 105     case 'let*'
 106         let_env = Env({env});
 107         for i=1:2:length(ast.get(2))
 108             let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env));
 109         end
 110         env = let_env;
 111         ast = ast.get(3); % TCO
 112     case 'quote'
 113         ret = ast.get(2);
 114         return;
 115     case 'quasiquote'
 116         ast = quasiquote(ast.get(2)); % TCO
 117     case 'defmacro!'
 118         ret = env.set(ast.get(2), EVAL(ast.get(3), env));
 119         ret.is_macro = true;
 120         return;
 121     case 'macroexpand'
 122         ret = macroexpand(ast.get(2), env);
 123         return;
 124     case 'try*'
 125         try
 126             ret = EVAL(ast.get(2), env);
 127             return;
 128         catch e
 129             if length(ast) > 2 && strcmp(ast.get(3).get(1).name, 'catch*')
 130                 if strcmp(e.identifier, 'MalException:object')
 131                     if exist('OCTAVE_VERSION', 'builtin') ~= 0
 132                         global error_object;
 133                         exc = error_object;
 134                     else
 135                         exc = e.obj;
 136                     end
 137                 else
 138                     exc = e.message;
 139                 end
 140                 catch_env = Env({env}, types.List(ast.get(3).get(2)), ...
 141                                 types.List(exc));
 142                 ret = EVAL(ast.get(3).get(3), catch_env);
 143                 return;
 144             else
 145                 throw(e);
 146             end
 147         end
 148     case 'do'
 149         el = eval_ast(ast.slice(2,length(ast)-1), env);
 150         ast = ast.get(length(ast)); % TCO
 151     case 'if'
 152         cond = EVAL(ast.get(2), env);
 153         if strcmp(class(cond), 'types.Nil') || ...
 154            (islogical(cond) && cond == false)
 155            if length(ast) > 3
 156                ast = ast.get(4); % TCO
 157             else
 158                ret = type_utils.nil;
 159                return;
 160             end
 161         else
 162             ast = ast.get(3); % TCO
 163         end
 164     case 'fn*'
 165         fn = @(varargin) EVAL(ast.get(3), Env({env}, ast.get(2), ...
 166                                               types.List(varargin{:})));
 167         ret = types.Function(fn, ast.get(3), env, ast.get(2));
 168         return;
 169     otherwise
 170         el = eval_ast(ast, env);
 171         f = el.get(1);
 172         args = el.slice(2);
 173         if isa(f, 'types.Function')
 174             env = Env({f.env}, f.params, args);
 175             ast = f.ast; % TCO
 176         else
 177             ret = f(args.data{:});
 178             return
 179         end
 180     end
 181   end
 182 end
 183
 184 % print
 185 function ret = PRINT(ast)
 186     ret = printer.pr_str(ast, true);
 187 end
 188
 189 % REPL
 190 function ret = rep(str, env)
 191     ret = PRINT(EVAL(READ(str), env));
 192 end
 193
 194 function main(args)
 195     repl_env = Env();
 196
 197     % core.m: defined using matlab
 198     ns = core.ns(); ks = ns.keys();
 199     for i=1:length(ks)
 200         k = ks{i};
 201         repl_env.set(types.Symbol(k), ns(k));
 202     end
 203     repl_env.set(types.Symbol('eval'), @(a) EVAL(a, repl_env));
 204     rest_args = args(2:end);
 205     repl_env.set(types.Symbol('*ARGV*'), types.List(rest_args{:}));
 206
 207     % core.mal: defined using the langauge itself
 208     rep('(def! *host-language* "matlab")', repl_env);
 209     rep('(def! not (fn* (a) (if a false true)))', repl_env);
 210     rep('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))"', repl_env);
 211     rep('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))', repl_env);
 212     rep('(def! *gensym-counter* (atom 0))', repl_env);
 213     rep('(def! gensym (fn* [] (symbol (str "G__" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))', repl_env);
 214     rep('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))', repl_env);
 215
 216     if ~isempty(args)
 217         rep(sprintf('(load-file "%s")', args{1}), repl_env);
 218         quit;
 219     end
 220
 221     %cleanObj = onCleanup(@() disp('*** here1 ***'));
 222     rep('(println (str "Mal [" *host-language* "]"))', repl_env);
 223     while (true)
 224         try
 225             line = input('user> ', 's');
 226         catch err
 227             return
 228         end
 229         if strcmp(strtrim(line),''), continue, end
 230         try
 231             fprintf('%s\n', rep(line, repl_env));
 232         catch err
 233             if strcmp('MalException:object', err.identifier)
 234                 if exist('OCTAVE_VERSION', 'builtin') ~= 0
 235                     global error_object;
 236                     fprintf('Error: %s\n', printer.pr_str(error_object, true));
 237                 else
 238                     fprintf('Error: %s\n', printer.pr_str(err.obj, true));
 239                 end
 240             else
 241                 fprintf('Error: %s\n', err.message);
 242             end
 243             type_utils.print_stack(err);
 244         end
 245     end
 246 end