Merge pull request #238 from prt2121/pt/haskell-7.10.1

[jackhill/mal.git] / matlab / stepA_mal.m

diff --git a/matlab/stepA_mal.m b/matlab/stepA_mal.m
index 6f74b6a..8883ac8 100644 (file)
--- a/matlab/stepA_mal.m
+++ b/matlab/stepA_mal.m
@@ -7,7 +7,7 @@ end
 
 % eval
 function ret = is_pair(ast)
-    ret = types.sequential_Q(ast) && length(ast) > 0;
+    ret = type_utils.sequential_Q(ast) && length(ast) > 0;
 end
 
 function ret = quasiquote(ast)
@@ -30,7 +30,7 @@ function ret = quasiquote(ast)
 end
 
 function ret = is_macro_call(ast, env)
-    if types.list_Q(ast) && isa(ast.get(1), 'types.Symbol') && ...
+    if type_utils.list_Q(ast) && isa(ast.get(1), 'types.Symbol') && ...
        ~islogical(env.find(ast.get(1)))
         f = env.get(ast.get(1));
         ret = isa(f,'types.Function') && f.is_macro;
@@ -77,17 +77,21 @@ end
 function ret = EVAL(ast, env)
   while true
     %fprintf('EVAL: %s\n', printer.pr_str(ast, true));
-    if ~types.list_Q(ast)
+    if ~type_utils.list_Q(ast)
         ret = eval_ast(ast, env);
         return;
     end
 
     % apply
-    ast = macroexpand(ast, env);
-    if ~types.list_Q(ast)
+    if length(ast) == 0
         ret = ast;
         return;
     end
+    ast = macroexpand(ast, env);
+    if ~type_utils.list_Q(ast)
+        ret = eval_ast(ast, env);
+        return;
+    end
 
     if isa(ast.get(1),'types.Symbol')
         a1sym = ast.get(1).name;
@@ -99,7 +103,7 @@ function ret = EVAL(ast, env)
         ret = env.set(ast.get(2), EVAL(ast.get(3), env));
         return;
     case 'let*'
-        let_env = Env(env);
+        let_env = Env({env});
         for i=1:2:length(ast.get(2))
             let_env.set(ast.get(2).get(i), EVAL(ast.get(2).get(i+1), let_env));
         end
@@ -123,12 +127,17 @@ function ret = EVAL(ast, env)
             return;
         catch e
             if length(ast) > 2 && strcmp(ast.get(3).get(1).name, 'catch*')
-                if isa(e, 'types.MalException')
-                    exc = e.obj;
+                if strcmp(e.identifier, 'MalException:object')
+                    if exist('OCTAVE_VERSION', 'builtin') ~= 0
+                        global error_object;
+                        exc = error_object;
+                    else
+                        exc = e.obj;
+                    end
                 else
                     exc = e.message;
                 end
-                catch_env = Env(env, types.List(ast.get(3).get(2)), ...
+                catch_env = Env({env}, types.List(ast.get(3).get(2)), ...
                                 types.List(exc));
                 ret = EVAL(ast.get(3).get(3), catch_env);
                 return;
@@ -146,14 +155,14 @@ function ret = EVAL(ast, env)
            if length(ast) > 3
                ast = ast.get(4); % TCO
             else
-               ret = types.nil;
+               ret = type_utils.nil;
                return;
             end
         else
             ast = ast.get(3); % TCO
         end
     case 'fn*'
-        fn = @(varargin) EVAL(ast.get(3), Env(env, ast.get(2), ...
+        fn = @(varargin) EVAL(ast.get(3), Env({env}, ast.get(2), ...
                                               types.List(varargin{:})));
         ret = types.Function(fn, ast.get(3), env, ast.get(2));
         return;
@@ -162,7 +171,7 @@ function ret = EVAL(ast, env)
         f = el.get(1);
         args = el.slice(2);
         if isa(f, 'types.Function')
-            env = Env(f.env, f.params, args);
+            env = Env({f.env}, f.params, args);
             ast = f.ast; % TCO
         else
             ret = f(args.data{:});
@@ -183,7 +192,7 @@ function ret = rep(str, env)
 end
 
 function main(args)
-    repl_env = Env(false);
+    repl_env = Env();
 
     % core.m: defined using matlab
     ns = core.ns(); ks = ns.keys();
@@ -200,7 +209,9 @@ function main(args)
     rep('(def! not (fn* (a) (if a false true)))', repl_env);
     rep('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))"', repl_env);
     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);
-    rep('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))', repl_env);
+    rep('(def! *gensym-counter* (atom 0))', repl_env);
+    rep('(def! gensym (fn* [] (symbol (str "G__" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))', repl_env);
+    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);
 
     if ~isempty(args)
         rep(sprintf('(load-file "%s")', args{1}), repl_env);
@@ -210,17 +221,26 @@ function main(args)
     %cleanObj = onCleanup(@() disp('*** here1 ***'));
     rep('(println (str "Mal [" *host-language* "]"))', repl_env);
     while (true)
-        line = input('user> ', 's');
+        try
+            line = input('user> ', 's');
+        catch err
+            return
+        end
         if strcmp(strtrim(line),''), continue, end
         try
             fprintf('%s\n', rep(line, repl_env));
         catch err
-            if isa(err, 'types.MalException')
-                fprintf('Error: %s\n', printer.pr_str(err.obj, true));
+            if strcmp('MalException:object', err.identifier)
+                if exist('OCTAVE_VERSION', 'builtin') ~= 0
+                    global error_object;
+                    fprintf('Error: %s\n', printer.pr_str(error_object, true));
+                else
+                    fprintf('Error: %s\n', printer.pr_str(err.obj, true));
+                end
             else
                 fprintf('Error: %s\n', err.message);
             end
-            fprintf('%s\n', getReport(err, 'extended'));
+            type_utils.print_stack(err);
         end
     end
 end