From 2764f89a1830f7a9458d66d310b6e198653bba71 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Wed, 9 Oct 2024 15:43:52 +0200 Subject: [PATCH] matlab: merge eval and eval_ast --- impls/matlab/Env.m | 28 ++++--------- impls/matlab/step2_eval.m | 32 +++++++-------- impls/matlab/step3_env.m | 46 +++++++++++++-------- impls/matlab/step4_if_fn_do.m | 51 ++++++++++++++--------- impls/matlab/step5_tco.m | 50 +++++++++++++++-------- impls/matlab/step6_file.m | 50 +++++++++++++++-------- impls/matlab/step7_quote.m | 53 ++++++++++++++---------- impls/matlab/step8_macros.m | 77 +++++++++++++++-------------------- impls/matlab/step9_try.m | 77 +++++++++++++++-------------------- impls/matlab/stepA_mal.m | 77 +++++++++++++++-------------------- 10 files changed, 276 insertions(+), 265 deletions(-) diff --git a/impls/matlab/Env.m b/impls/matlab/Env.m index d541a14348..dcc64b2735 100644 --- a/impls/matlab/Env.m +++ b/impls/matlab/Env.m @@ -38,30 +38,16 @@ env.data(k.name) = v; ret = v; end - function ret = find(env, k) - if env.data.isKey(k.name) - ret = env; - else - if ~islogical(env.outer) - ret = env.outer.find(k); - else - ret = false; - end - end - end + function ret = get(env, k) - fenv = env.find(k); - if ~islogical(fenv) - ret = fenv.data(k.name); - else - if exist('OCTAVE_VERSION', 'builtin') ~= 0 - error('ENV:notfound', ... - sprintf('''%s'' not found', k.name)); - else - throw(MException('ENV:notfound', ... - sprintf('''%s'' not found', k.name))); + while ~env.data.isKey(k) + env = env.outer; + if islogical(env) + ret = {}; + return; end end + ret = env.data(k); end end end diff --git a/impls/matlab/step2_eval.m b/impls/matlab/step2_eval.m index 0f20237063..c493da9dcf 100644 --- a/impls/matlab/step2_eval.m +++ b/impls/matlab/step2_eval.m @@ -6,20 +6,22 @@ function step2_eval(varargin), main(varargin), end end % eval -function ret = eval_ast(ast, env) +function ret = EVAL(ast, env) + + % fprintf('EVAL: %s\n', printer.pr_str(ast, true)); + switch class(ast) case 'types.Symbol' ret = env(ast.name); + return; case 'types.List' - ret = types.List(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); - end + % Proceed after this switch. case 'types.Vector' ret = types.Vector(); for i=1:length(ast) ret.append(EVAL(ast.get(i), env)); end + return; case 'types.HashMap' ret = types.HashMap(); ks = ast.keys(); @@ -27,15 +29,9 @@ function step2_eval(varargin), main(varargin), end k = ks{i}; ret.set(k, EVAL(ast.get(k), env)); end + return; otherwise ret = ast; - end -end - -function ret = EVAL(ast, env) - %fprintf('EVAL: %s\n', printer.pr_str(ast, true)); - if ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); return; end @@ -44,10 +40,14 @@ function step2_eval(varargin), main(varargin), end ret = ast; return; end - el = eval_ast(ast, env); - f = el.get(1); - args = el.data(2:end); - ret = f(args{:}); + + f = EVAL(ast.get(1), env); + args = types.List(); + for i=2:length(ast) + args.append(EVAL(ast.get(i), env)); + end + ret = f(args.data{:}); + end % print diff --git a/impls/matlab/step3_env.m b/impls/matlab/step3_env.m index c85e5c69c8..1c2de94acf 100644 --- a/impls/matlab/step3_env.m +++ b/impls/matlab/step3_env.m @@ -6,20 +6,35 @@ function step3_env(varargin), main(varargin), end end % eval -function ret = eval_ast(ast, env) +function ret = EVAL(ast, env) + + dbgeval = env.get('DEBUG-EVAL'); + if ~isequal(dbgeval, {}) ... + && ~strcmp(class(dbgeval), 'types.Nil') ... + && (~islogical(dbgeval) || dbgeval) + fprintf('EVAL: %s\n', printer.pr_str(ast, true)); + end + switch class(ast) case 'types.Symbol' - ret = env.get(ast); - case 'types.List' - ret = types.List(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); + ret = env.get(ast.name); + if isequal(ret, {}) + msg = sprintf('''%s'' not found', ast.name); + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + error('ENV:notfound', msg); + else + throw(MException('ENV:notfound', msg)); + end end + return; + case 'types.List' + % Proceed after this switch. case 'types.Vector' ret = types.Vector(); for i=1:length(ast) ret.append(EVAL(ast.get(i), env)); end + return; case 'types.HashMap' ret = types.HashMap(); ks = ast.keys(); @@ -27,15 +42,9 @@ function step3_env(varargin), main(varargin), end k = ks{i}; ret.set(k, EVAL(ast.get(k), env)); end + return; otherwise ret = ast; - end -end - -function ret = EVAL(ast, env) - %fprintf('EVAL: %s\n', printer.pr_str(ast, true)); - if ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); return; end @@ -44,6 +53,7 @@ function step3_env(varargin), main(varargin), end ret = ast; return; end + if isa(ast.get(1),'types.Symbol') a1sym = ast.get(1).name; else @@ -59,10 +69,12 @@ function step3_env(varargin), main(varargin), end end ret = EVAL(ast.get(3), let_env); otherwise - el = eval_ast(ast, env); - f = el.get(1); - args = el.data(2:end); - ret = f(args{:}); + f = EVAL(ast.get(1), env); + args = types.List(); + for i=2:length(ast) + args.append(EVAL(ast.get(i), env)); + end + ret = f(args.data{:}); end end diff --git a/impls/matlab/step4_if_fn_do.m b/impls/matlab/step4_if_fn_do.m index 2e1b651327..f128c1b7c1 100644 --- a/impls/matlab/step4_if_fn_do.m +++ b/impls/matlab/step4_if_fn_do.m @@ -6,20 +6,35 @@ function step4_if_fn_do(varargin), main(varargin), end end % eval -function ret = eval_ast(ast, env) +function ret = EVAL(ast, env) + + dbgeval = env.get('DEBUG-EVAL'); + if ~isequal(dbgeval, {}) ... + && ~strcmp(class(dbgeval), 'types.Nil') ... + && (~islogical(dbgeval) || dbgeval) + fprintf('EVAL: %s\n', printer.pr_str(ast, true)); + end + switch class(ast) case 'types.Symbol' - ret = env.get(ast); - case 'types.List' - ret = types.List(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); + ret = env.get(ast.name); + if isequal(ret, {}) + msg = sprintf('''%s'' not found', ast.name); + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + error('ENV:notfound', msg); + else + throw(MException('ENV:notfound', msg)); + end end + return; + case 'types.List' + % Proceed after this switch. case 'types.Vector' ret = types.Vector(); for i=1:length(ast) ret.append(EVAL(ast.get(i), env)); end + return; case 'types.HashMap' ret = types.HashMap(); ks = ast.keys(); @@ -27,15 +42,9 @@ function step4_if_fn_do(varargin), main(varargin), end k = ks{i}; ret.set(k, EVAL(ast.get(k), env)); end + return; otherwise ret = ast; - end -end - -function ret = EVAL(ast, env) - %fprintf('EVAL: %s\n', printer.pr_str(ast, true)); - if ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); return; end @@ -44,6 +53,7 @@ function step4_if_fn_do(varargin), main(varargin), end ret = ast; return; end + if isa(ast.get(1),'types.Symbol') a1sym = ast.get(1).name; else @@ -59,8 +69,9 @@ function step4_if_fn_do(varargin), main(varargin), end end ret = EVAL(ast.get(3), let_env); case 'do' - el = eval_ast(ast.slice(2), env); - ret = el.get(length(el)); + for i=2:length(ast) + ret = EVAL(ast.get(i), env); + end case 'if' cond = EVAL(ast.get(2), env); if strcmp(class(cond), 'types.Nil') || ... @@ -77,10 +88,12 @@ function step4_if_fn_do(varargin), main(varargin), end ret = @(varargin) EVAL(ast.get(3), Env({env}, ast.get(2), ... types.List(varargin{:}))); otherwise - el = eval_ast(ast, env); - f = el.get(1); - args = el.data(2:end); - ret = f(args{:}); + f = EVAL(ast.get(1), env); + args = types.List(); + for i=2:length(ast) + args.append(EVAL(ast.get(i), env)); + end + ret = f(args.data{:}); end end diff --git a/impls/matlab/step5_tco.m b/impls/matlab/step5_tco.m index bd0c5a1244..e092ac92f3 100644 --- a/impls/matlab/step5_tco.m +++ b/impls/matlab/step5_tco.m @@ -6,20 +6,36 @@ function step5_tco(varargin), main(varargin), end end % eval -function ret = eval_ast(ast, env) +function ret = EVAL(ast, env) + while true + + dbgeval = env.get('DEBUG-EVAL'); + if ~isequal(dbgeval, {}) ... + && ~strcmp(class(dbgeval), 'types.Nil') ... + && (~islogical(dbgeval) || dbgeval) + fprintf('EVAL: %s\n', printer.pr_str(ast, true)); + end + switch class(ast) case 'types.Symbol' - ret = env.get(ast); - case 'types.List' - ret = types.List(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); + ret = env.get(ast.name); + if isequal(ret, {}) + msg = sprintf('''%s'' not found', ast.name); + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + error('ENV:notfound', msg); + else + throw(MException('ENV:notfound', msg)); + end end + return; + case 'types.List' + % Proceed after this switch. case 'types.Vector' ret = types.Vector(); for i=1:length(ast) ret.append(EVAL(ast.get(i), env)); end + return; case 'types.HashMap' ret = types.HashMap(); ks = ast.keys(); @@ -27,16 +43,9 @@ function step5_tco(varargin), main(varargin), end k = ks{i}; ret.set(k, EVAL(ast.get(k), env)); end + return; otherwise ret = ast; - end -end - -function ret = EVAL(ast, env) - while true - %fprintf('EVAL: %s\n', printer.pr_str(ast, true)); - if ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); return; end @@ -45,6 +54,7 @@ function step5_tco(varargin), main(varargin), end ret = ast; return; end + if isa(ast.get(1),'types.Symbol') a1sym = ast.get(1).name; else @@ -62,7 +72,9 @@ function step5_tco(varargin), main(varargin), end env = let_env; ast = ast.get(3); % TCO case 'do' - el = eval_ast(ast.slice(2,length(ast)-1), env); + for i=2:(length(ast) -1) + ret = EVAL(ast.get(i), env); + end ast = ast.get(length(ast)); % TCO case 'if' cond = EVAL(ast.get(2), env); @@ -83,9 +95,11 @@ function step5_tco(varargin), main(varargin), end ret = types.Function(fn, ast.get(3), env, ast.get(2)); return; otherwise - el = eval_ast(ast, env); - f = el.get(1); - args = el.slice(2); + f = EVAL(ast.get(1), env); + args = types.List(); + for i=2:length(ast) + args.append(EVAL(ast.get(i), env)); + end if isa(f, 'types.Function') env = Env({f.env}, f.params, args); ast = f.ast; % TCO diff --git a/impls/matlab/step6_file.m b/impls/matlab/step6_file.m index 3488a25e9c..b5d69f8c63 100644 --- a/impls/matlab/step6_file.m +++ b/impls/matlab/step6_file.m @@ -6,20 +6,36 @@ function step6_file(varargin), main(varargin), end end % eval -function ret = eval_ast(ast, env) +function ret = EVAL(ast, env) + while true + + dbgeval = env.get('DEBUG-EVAL'); + if ~isequal(dbgeval, {}) ... + && ~strcmp(class(dbgeval), 'types.Nil') ... + && (~islogical(dbgeval) || dbgeval) + fprintf('EVAL: %s\n', printer.pr_str(ast, true)); + end + switch class(ast) case 'types.Symbol' - ret = env.get(ast); - case 'types.List' - ret = types.List(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); + ret = env.get(ast.name); + if isequal(ret, {}) + msg = sprintf('''%s'' not found', ast.name); + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + error('ENV:notfound', msg); + else + throw(MException('ENV:notfound', msg)); + end end + return; + case 'types.List' + % Proceed after this switch. case 'types.Vector' ret = types.Vector(); for i=1:length(ast) ret.append(EVAL(ast.get(i), env)); end + return; case 'types.HashMap' ret = types.HashMap(); ks = ast.keys(); @@ -27,16 +43,9 @@ function step6_file(varargin), main(varargin), end k = ks{i}; ret.set(k, EVAL(ast.get(k), env)); end + return; otherwise ret = ast; - end -end - -function ret = EVAL(ast, env) - while true - %fprintf('EVAL: %s\n', printer.pr_str(ast, true)); - if ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); return; end @@ -45,6 +54,7 @@ function step6_file(varargin), main(varargin), end ret = ast; return; end + if isa(ast.get(1),'types.Symbol') a1sym = ast.get(1).name; else @@ -62,7 +72,9 @@ function step6_file(varargin), main(varargin), end env = let_env; ast = ast.get(3); % TCO case 'do' - el = eval_ast(ast.slice(2,length(ast)-1), env); + for i=2:(length(ast) -1) + ret = EVAL(ast.get(i), env); + end ast = ast.get(length(ast)); % TCO case 'if' cond = EVAL(ast.get(2), env); @@ -83,9 +95,11 @@ function step6_file(varargin), main(varargin), end ret = types.Function(fn, ast.get(3), env, ast.get(2)); return; otherwise - el = eval_ast(ast, env); - f = el.get(1); - args = el.slice(2); + f = EVAL(ast.get(1), env); + args = types.List(); + for i=2:length(ast) + args.append(EVAL(ast.get(i), env)); + end if isa(f, 'types.Function') env = Env({f.env}, f.params, args); ast = f.ast; % TCO diff --git a/impls/matlab/step7_quote.m b/impls/matlab/step7_quote.m index 311d283a65..ef5a9a7c02 100644 --- a/impls/matlab/step7_quote.m +++ b/impls/matlab/step7_quote.m @@ -43,20 +43,36 @@ function step7_quote(varargin), main(varargin), end end end -function ret = eval_ast(ast, env) +function ret = EVAL(ast, env) + while true + + dbgeval = env.get('DEBUG-EVAL'); + if ~isequal(dbgeval, {}) ... + && ~strcmp(class(dbgeval), 'types.Nil') ... + && (~islogical(dbgeval) || dbgeval) + fprintf('EVAL: %s\n', printer.pr_str(ast, true)); + end + switch class(ast) case 'types.Symbol' - ret = env.get(ast); - case 'types.List' - ret = types.List(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); + ret = env.get(ast.name); + if isequal(ret, {}) + msg = sprintf('''%s'' not found', ast.name); + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + error('ENV:notfound', msg); + else + throw(MException('ENV:notfound', msg)); + end end + return; + case 'types.List' + % Proceed after this switch. case 'types.Vector' ret = types.Vector(); for i=1:length(ast) ret.append(EVAL(ast.get(i), env)); end + return; case 'types.HashMap' ret = types.HashMap(); ks = ast.keys(); @@ -64,16 +80,9 @@ function step7_quote(varargin), main(varargin), end k = ks{i}; ret.set(k, EVAL(ast.get(k), env)); end + return; otherwise ret = ast; - end -end - -function ret = EVAL(ast, env) - while true - %fprintf('EVAL: %s\n', printer.pr_str(ast, true)); - if ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); return; end @@ -82,6 +91,7 @@ function step7_quote(varargin), main(varargin), end ret = ast; return; end + if isa(ast.get(1),'types.Symbol') a1sym = ast.get(1).name; else @@ -101,13 +111,12 @@ function step7_quote(varargin), main(varargin), end case 'quote' ret = ast.get(2); return; - case 'quasiquoteexpand' - ret = quasiquote(ast.get(2)); - return; case 'quasiquote' ast = quasiquote(ast.get(2)); % TCO case 'do' - el = eval_ast(ast.slice(2,length(ast)-1), env); + for i=2:(length(ast) -1) + ret = EVAL(ast.get(i), env); + end ast = ast.get(length(ast)); % TCO case 'if' cond = EVAL(ast.get(2), env); @@ -128,9 +137,11 @@ function step7_quote(varargin), main(varargin), end ret = types.Function(fn, ast.get(3), env, ast.get(2)); return; otherwise - el = eval_ast(ast, env); - f = el.get(1); - args = el.slice(2); + f = EVAL(ast.get(1), env); + args = types.List(); + for i=2:length(ast) + args.append(EVAL(ast.get(i), env)); + end if isa(f, 'types.Function') env = Env({f.env}, f.params, args); ast = f.ast; % TCO diff --git a/impls/matlab/step8_macros.m b/impls/matlab/step8_macros.m index fe9cc048e0..9693e69f0d 100644 --- a/impls/matlab/step8_macros.m +++ b/impls/matlab/step8_macros.m @@ -43,39 +43,36 @@ function step8_macros(varargin), main(varargin), end end end -function ret = is_macro_call(ast, env) - 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; - else - ret = false; - end -end +function ret = EVAL(ast, env) + while true -function ret = macroexpand(ast, env) - while is_macro_call(ast, env) - mac = env.get(ast.get(1)); - args = ast.slice(2); - ast = mac.fn(args.data{:}); + dbgeval = env.get('DEBUG-EVAL'); + if ~isequal(dbgeval, {}) ... + && ~strcmp(class(dbgeval), 'types.Nil') ... + && (~islogical(dbgeval) || dbgeval) + fprintf('EVAL: %s\n', printer.pr_str(ast, true)); end - ret = ast; -end -function ret = eval_ast(ast, env) switch class(ast) case 'types.Symbol' - ret = env.get(ast); - case 'types.List' - ret = types.List(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); + ret = env.get(ast.name); + if isequal(ret, {}) + msg = sprintf('''%s'' not found', ast.name); + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + error('ENV:notfound', msg); + else + throw(MException('ENV:notfound', msg)); + end end + return; + case 'types.List' + % Proceed after this switch. case 'types.Vector' ret = types.Vector(); for i=1:length(ast) ret.append(EVAL(ast.get(i), env)); end + return; case 'types.HashMap' ret = types.HashMap(); ks = ast.keys(); @@ -83,16 +80,9 @@ function step8_macros(varargin), main(varargin), end k = ks{i}; ret.set(k, EVAL(ast.get(k), env)); end + return; otherwise ret = ast; - end -end - -function ret = EVAL(ast, env) - while true - %fprintf('EVAL: %s\n', printer.pr_str(ast, true)); - if ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); return; end @@ -101,11 +91,6 @@ function step8_macros(varargin), main(varargin), end 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; @@ -126,20 +111,16 @@ function step8_macros(varargin), main(varargin), end case 'quote' ret = ast.get(2); return; - case 'quasiquoteexpand' - ret = quasiquote(ast.get(2)); - return; case 'quasiquote' ast = quasiquote(ast.get(2)); % TCO case 'defmacro!' ret = env.set(ast.get(2), EVAL(ast.get(3), env).clone()); ret.is_macro = true; return; - case 'macroexpand' - ret = macroexpand(ast.get(2), env); - return; case 'do' - el = eval_ast(ast.slice(2,length(ast)-1), env); + for i=2:(length(ast) -1) + ret = EVAL(ast.get(i), env); + end ast = ast.get(length(ast)); % TCO case 'if' cond = EVAL(ast.get(2), env); @@ -160,9 +141,14 @@ function step8_macros(varargin), main(varargin), end ret = types.Function(fn, ast.get(3), env, ast.get(2)); return; otherwise - el = eval_ast(ast, env); - f = el.get(1); - args = el.slice(2); + f = EVAL(ast.get(1), env); + if isa(f,'types.Function') && f.is_macro + ast = f.fn(ast.slice(2).data{:}); % TCO + else + args = types.List(); + for i=2:length(ast) + args.append(EVAL(ast.get(i), env)); + end if isa(f, 'types.Function') env = Env({f.env}, f.params, args); ast = f.ast; % TCO @@ -170,6 +156,7 @@ function step8_macros(varargin), main(varargin), end ret = f(args.data{:}); return end + end end end end diff --git a/impls/matlab/step9_try.m b/impls/matlab/step9_try.m index be1cbc444e..eaa35ac60a 100644 --- a/impls/matlab/step9_try.m +++ b/impls/matlab/step9_try.m @@ -43,39 +43,36 @@ function step9_try(varargin), main(varargin), end end end -function ret = is_macro_call(ast, env) - 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; - else - ret = false; - end -end +function ret = EVAL(ast, env) + while true -function ret = macroexpand(ast, env) - while is_macro_call(ast, env) - mac = env.get(ast.get(1)); - args = ast.slice(2); - ast = mac.fn(args.data{:}); + dbgeval = env.get('DEBUG-EVAL'); + if ~isequal(dbgeval, {}) ... + && ~strcmp(class(dbgeval), 'types.Nil') ... + && (~islogical(dbgeval) || dbgeval) + fprintf('EVAL: %s\n', printer.pr_str(ast, true)); end - ret = ast; -end -function ret = eval_ast(ast, env) switch class(ast) case 'types.Symbol' - ret = env.get(ast); - case 'types.List' - ret = types.List(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); + ret = env.get(ast.name); + if isequal(ret, {}) + msg = sprintf('''%s'' not found', ast.name); + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + error('ENV:notfound', msg); + else + throw(MException('ENV:notfound', msg)); + end end + return; + case 'types.List' + % Proceed after this switch. case 'types.Vector' ret = types.Vector(); for i=1:length(ast) ret.append(EVAL(ast.get(i), env)); end + return; case 'types.HashMap' ret = types.HashMap(); ks = ast.keys(); @@ -83,16 +80,9 @@ function step9_try(varargin), main(varargin), end k = ks{i}; ret.set(k, EVAL(ast.get(k), env)); end + return; otherwise ret = ast; - end -end - -function ret = EVAL(ast, env) - while true - %fprintf('EVAL: %s\n', printer.pr_str(ast, true)); - if ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); return; end @@ -101,11 +91,6 @@ function step9_try(varargin), main(varargin), end 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; @@ -126,18 +111,12 @@ function step9_try(varargin), main(varargin), end case 'quote' ret = ast.get(2); return; - case 'quasiquoteexpand' - ret = quasiquote(ast.get(2)); - return; case 'quasiquote' ast = quasiquote(ast.get(2)); % TCO case 'defmacro!' ret = env.set(ast.get(2), EVAL(ast.get(3), env).clone()); ret.is_macro = true; return; - case 'macroexpand' - ret = macroexpand(ast.get(2), env); - return; case 'try*' try ret = EVAL(ast.get(2), env); @@ -163,7 +142,9 @@ function step9_try(varargin), main(varargin), end end end case 'do' - el = eval_ast(ast.slice(2,length(ast)-1), env); + for i=2:(length(ast) -1) + ret = EVAL(ast.get(i), env); + end ast = ast.get(length(ast)); % TCO case 'if' cond = EVAL(ast.get(2), env); @@ -184,9 +165,14 @@ function step9_try(varargin), main(varargin), end ret = types.Function(fn, ast.get(3), env, ast.get(2)); return; otherwise - el = eval_ast(ast, env); - f = el.get(1); - args = el.slice(2); + f = EVAL(ast.get(1), env); + if isa(f,'types.Function') && f.is_macro + ast = f.fn(ast.slice(2).data{:}); % TCO + else + args = types.List(); + for i=2:length(ast) + args.append(EVAL(ast.get(i), env)); + end if isa(f, 'types.Function') env = Env({f.env}, f.params, args); ast = f.ast; % TCO @@ -194,6 +180,7 @@ function step9_try(varargin), main(varargin), end ret = f(args.data{:}); return end + end end end end diff --git a/impls/matlab/stepA_mal.m b/impls/matlab/stepA_mal.m index f892fde747..77dbb3374a 100644 --- a/impls/matlab/stepA_mal.m +++ b/impls/matlab/stepA_mal.m @@ -43,39 +43,36 @@ function stepA_mal(varargin), main(varargin), end end end -function ret = is_macro_call(ast, env) - 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; - else - ret = false; - end -end +function ret = EVAL(ast, env) + while true -function ret = macroexpand(ast, env) - while is_macro_call(ast, env) - mac = env.get(ast.get(1)); - args = ast.slice(2); - ast = mac.fn(args.data{:}); + dbgeval = env.get('DEBUG-EVAL'); + if ~isequal(dbgeval, {}) ... + && ~strcmp(class(dbgeval), 'types.Nil') ... + && (~islogical(dbgeval) || dbgeval) + fprintf('EVAL: %s\n', printer.pr_str(ast, true)); end - ret = ast; -end -function ret = eval_ast(ast, env) switch class(ast) case 'types.Symbol' - ret = env.get(ast); - case 'types.List' - ret = types.List(); - for i=1:length(ast) - ret.append(EVAL(ast.get(i), env)); + ret = env.get(ast.name); + if isequal(ret, {}) + msg = sprintf('''%s'' not found', ast.name); + if exist('OCTAVE_VERSION', 'builtin') ~= 0 + error('ENV:notfound', msg); + else + throw(MException('ENV:notfound', msg)); + end end + return; + case 'types.List' + % Proceed after this switch. case 'types.Vector' ret = types.Vector(); for i=1:length(ast) ret.append(EVAL(ast.get(i), env)); end + return; case 'types.HashMap' ret = types.HashMap(); ks = ast.keys(); @@ -83,16 +80,9 @@ function stepA_mal(varargin), main(varargin), end k = ks{i}; ret.set(k, EVAL(ast.get(k), env)); end + return; otherwise ret = ast; - end -end - -function ret = EVAL(ast, env) - while true - %fprintf('EVAL: %s\n', printer.pr_str(ast, true)); - if ~type_utils.list_Q(ast) - ret = eval_ast(ast, env); return; end @@ -101,11 +91,6 @@ function stepA_mal(varargin), main(varargin), end 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; @@ -126,18 +111,12 @@ function stepA_mal(varargin), main(varargin), end case 'quote' ret = ast.get(2); return; - case 'quasiquoteexpand' - ret = quasiquote(ast.get(2)); - return; case 'quasiquote' ast = quasiquote(ast.get(2)); % TCO case 'defmacro!' ret = env.set(ast.get(2), EVAL(ast.get(3), env).clone()); ret.is_macro = true; return; - case 'macroexpand' - ret = macroexpand(ast.get(2), env); - return; case 'try*' try ret = EVAL(ast.get(2), env); @@ -163,7 +142,9 @@ function stepA_mal(varargin), main(varargin), end end end case 'do' - el = eval_ast(ast.slice(2,length(ast)-1), env); + for i=2:(length(ast) -1) + ret = EVAL(ast.get(i), env); + end ast = ast.get(length(ast)); % TCO case 'if' cond = EVAL(ast.get(2), env); @@ -184,9 +165,14 @@ function stepA_mal(varargin), main(varargin), end ret = types.Function(fn, ast.get(3), env, ast.get(2)); return; otherwise - el = eval_ast(ast, env); - f = el.get(1); - args = el.slice(2); + f = EVAL(ast.get(1), env); + if isa(f,'types.Function') && f.is_macro + ast = f.fn(ast.slice(2).data{:}); % TCO + else + args = types.List(); + for i=2:length(ast) + args.append(EVAL(ast.get(i), env)); + end if isa(f, 'types.Function') env = Env({f.env}, f.params, args); ast = f.ast; % TCO @@ -194,6 +180,7 @@ function stepA_mal(varargin), main(varargin), end ret = f(args.data{:}); return end + end end end end