matlab/step7_quote.m

   1 function step7_quote(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 = eval_ast(ast, env)
  33     switch class(ast)
  34     case 'types.Symbol'
  35         ret = env.get(ast);
  36     case 'types.List'
  37         ret = types.List();
  38         for i=1:length(ast)
  39             ret.append(EVAL(ast.get(i), env));
  40         end
  41     case 'types.Vector'
  42         ret = types.Vector();
  43         for i=1:length(ast)
  44             ret.append(EVAL(ast.get(i), env));
  45         end
  46     case 'types.HashMap'
  47         ret = types.HashMap();
  48         ks = ast.keys();
  49         for i=1:length(ks)
  50             k = ks{i};
  51             ret.set(EVAL(k, env), EVAL(ast.get(k), env));
  52         end
  53     otherwise
  54         ret = ast;
  55     end
  56 end
  57
  58 function ret = EVAL(ast, env)
  59   while true
  60     %fprintf('EVAL: %s\n', printer.pr_str(ast, true));
  61     if ~type_utils.list_Q(ast)
  62         ret = eval_ast(ast, env);
  63         return;
  64     end
  65
  66     % apply
  67     if length(ast) == 0
  68         ret = ast;
  69         return;
  70     end
  71     if isa(ast.get(1),'types.Symbol')
  72         a1sym = ast.get(1).name;
  73     else
  74         a1sym = '_@$fn$@_';
  75     end
  76     switch (a1sym)
  77     case 'def!'
  78         ret = env.set(ast.get(2), EVAL(ast.get(3), env));
  79         return;
  80     case 'let*'
  81         let_env = Env({env});
  82         for i=1:2:length(ast.get(2))
  83             let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env));
  84         end
  85         env = let_env;
  86         ast = ast.get(3); % TCO
  87     case 'quote'
  88         ret = ast.get(2);
  89         return;
  90     case 'quasiquote'
  91         ast = quasiquote(ast.get(2)); % TCO
  92     case 'do'
  93         el = eval_ast(ast.slice(2,length(ast)-1), env);
  94         ast = ast.get(length(ast)); % TCO
  95     case 'if'
  96         cond = EVAL(ast.get(2), env);
  97         if strcmp(class(cond), 'types.Nil') || ...
  98            (islogical(cond) && cond == false)
  99            if length(ast) > 3
 100                ast = ast.get(4); % TCO
 101             else
 102                ret = type_utils.nil;
 103                return;
 104             end
 105         else
 106             ast = ast.get(3); % TCO
 107         end
 108     case 'fn*'
 109         fn = @(varargin) EVAL(ast.get(3), Env({env}, ast.get(2), ...
 110                                               types.List(varargin{:})));
 111         ret = types.Function(fn, ast.get(3), env, ast.get(2));
 112         return;
 113     otherwise
 114         el = eval_ast(ast, env);
 115         f = el.get(1);
 116         args = el.slice(2);
 117         if isa(f, 'types.Function')
 118             env = Env({f.env}, f.params, args);
 119             ast = f.ast; % TCO
 120         else
 121             ret = f(args.data{:});
 122             return
 123         end
 124     end
 125   end
 126 end
 127
 128 % print
 129 function ret = PRINT(ast)
 130     ret = printer.pr_str(ast, true);
 131 end
 132
 133 % REPL
 134 function ret = rep(str, env)
 135     ret = PRINT(EVAL(READ(str), env));
 136 end
 137
 138 function main(args)
 139     repl_env = Env();
 140
 141     % core.m: defined using matlab
 142     ns = core.ns(); ks = ns.keys();
 143     for i=1:length(ks)
 144         k = ks{i};
 145         repl_env.set(types.Symbol(k), ns(k));
 146     end
 147     repl_env.set(types.Symbol('eval'), @(a) EVAL(a, repl_env));
 148     rest_args = args(2:end);
 149     repl_env.set(types.Symbol('*ARGV*'), types.List(rest_args{:}));
 150
 151     % core.mal: defined using the langauge itself
 152     rep('(def! not (fn* (a) (if a false true)))', repl_env);
 153     rep('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))"', repl_env);
 154
 155     if ~isempty(args)
 156         rep(sprintf('(load-file "%s")', args{1}), repl_env);
 157         quit;
 158     end
 159
 160     %cleanObj = onCleanup(@() disp('*** here1 ***'));
 161     while (true)
 162         try
 163             line = input('user> ', 's');
 164         catch err
 165             return
 166         end
 167         if strcmp(strtrim(line),''), continue, end
 168         try
 169             fprintf('%s\n', rep(line, repl_env));
 170         catch err
 171             fprintf('Error: %s\n', err.message);
 172             type_utils.print_stack(err);
 173         end
 174     end
 175 end