aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoel Martin <github@martintribe.org>2015-02-09 00:23:10 -0600
committerJoel Martin <github@martintribe.org>2015-02-09 00:23:10 -0600
commit7f567f36457b937c36345becdb7c1101566dcdf3 (patch)
tree6481177a8a297475b3b361503e66315e5698b11d
parentb550d8b72a16aa83de1de9e76ac66ab000a0ef2f (diff)
downloadmal-7f567f36457b937c36345becdb7c1101566dcdf3.tar.gz
mal-7f567f36457b937c36345becdb7c1101566dcdf3.zip
matlab: stepA, perf test, comments.
-rw-r--r--Makefile4
-rw-r--r--matlab/core.m6
-rw-r--r--matlab/reader.m4
-rw-r--r--matlab/step8_macros.m2
-rw-r--r--matlab/step9_try.m2
-rw-r--r--matlab/stepA_interop.m207
-rw-r--r--perf.mal4
7 files changed, 222 insertions, 7 deletions
diff --git a/Makefile b/Makefile
index a7969d6..9a9054c 100644
--- a/Makefile
+++ b/Makefile
@@ -92,8 +92,8 @@ lua_RUNSTEP = ../$(2) $(3)
make_RUNSTEP = make -f ../$(2) $(3)
mal_RUNSTEP = $(call $(MAL_IMPL)_RUNSTEP,$(1),$(call $(MAL_IMPL)_STEP_TO_PROG,stepA),../$(2),") #"
ocaml_RUNSTEP = ../$(2) $(3)
-matlab_args = $(subst $(SPACE),$(COMMA),$(patsubst %,'%',$(strip $(1))))
-matlab_RUNSTEP = matlab -nodisplay -nosplash -nodesktop -nojvm -r "$($(1))($(call matlab_args,$(4)));quit;"
+matlab_args = $(subst $(SPACE),$(COMMA),$(foreach x,$(strip $(1)),'$(x)'))
+matlab_RUNSTEP = matlab -nodisplay -nosplash -nodesktop -nojvm -r "$($(1))($(call matlab_args,$(3)));quit;"
perl_RUNSTEP = perl ../$(2) --raw $(3)
php_RUNSTEP = php ../$(2) $(3)
ps_RUNSTEP = $(4)gs -q -I./ -dNODISPLAY -- ../$(2) $(3)$(4)
diff --git a/matlab/core.m b/matlab/core.m
index 578ec4d..ee86ad9 100644
--- a/matlab/core.m
+++ b/matlab/core.m
@@ -28,6 +28,11 @@ classdef core
ret = types.nil;
end
+ function ret = time_ms()
+ secs = now-repmat(datenum('1970-1-1 00:00:00'),size(now));
+ ret = floor(secs.*repmat(24*3600.0*1000,size(now)));
+ end
+
function ret = concat(varargin)
if nargin == 0
ret = {};
@@ -96,6 +101,7 @@ classdef core
n('-') = @(a,b) a-b;
n('*') = @(a,b) a*b;
n('/') = @(a,b) floor(a/b);
+ n('time-ms') = @core.time_ms;
n('list') = @(varargin) varargin;
n('list?') = @iscell;
diff --git a/matlab/reader.m b/matlab/reader.m
index 968e5a1..0a985e8 100644
--- a/matlab/reader.m
+++ b/matlab/reader.m
@@ -2,9 +2,11 @@
classdef reader
methods (Static = true)
function tokens = tokenize(str)
- re = '[\s,]*(~@|[\[\]{}()''`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}(''"`,;)]*)';
+ re = '[\s,]*(~@|[\[\]{}()''`~^@]|"(?:\\.|[^\\"])*"|;[^\n]*|[^\s\[\]{}(''"`,;)]*)';
% extract the capture group (to ignore spaces and commas)
tokens = cellfun(@(x) x(1), regexp(str, re, 'tokens'));
+ comments = cellfun(@(x) length(x) > 0 && x(1) == ';', tokens);
+ tokens = tokens(~comments);
end
function atm = read_atom(rdr)
diff --git a/matlab/step8_macros.m b/matlab/step8_macros.m
index 8910946..a4b45c2 100644
--- a/matlab/step8_macros.m
+++ b/matlab/step8_macros.m
@@ -32,7 +32,7 @@ function ret = is_macro_call(ast, env)
if iscell(ast) && isa(ast{1}, 'types.Symbol') && ...
~islogical(env.find(ast{1}))
f = env.get(ast{1});
- ret = isa(f,'Function') && f.is_macro;
+ ret = isa(f,'types.Function') && f.is_macro;
else
ret = false;
end
diff --git a/matlab/step9_try.m b/matlab/step9_try.m
index 4ffaf41..4880aac 100644
--- a/matlab/step9_try.m
+++ b/matlab/step9_try.m
@@ -32,7 +32,7 @@ function ret = is_macro_call(ast, env)
if iscell(ast) && isa(ast{1}, 'types.Symbol') && ...
~islogical(env.find(ast{1}))
f = env.get(ast{1});
- ret = isa(f,'Function') && f.is_macro;
+ ret = isa(f,'types.Function') && f.is_macro;
else
ret = false;
end
diff --git a/matlab/stepA_interop.m b/matlab/stepA_interop.m
new file mode 100644
index 0000000..4972095
--- /dev/null
+++ b/matlab/stepA_interop.m
@@ -0,0 +1,207 @@
+function stepA_interop(varargin), main(varargin), end
+
+% read
+function ret = READ(str)
+ ret = reader.read_str(str);
+end
+
+% eval
+function ret = is_pair(ast)
+ ret = iscell(ast) && length(ast) > 0;
+end
+
+function ret = quasiquote(ast)
+ if ~is_pair(ast)
+ ret = {types.Symbol('quote'), ast};
+ elseif isa(ast{1},'types.Symbol') && ...
+ strcmp(ast{1}.name, 'unquote')
+ ret = ast{2};
+ elseif is_pair(ast{1}) && isa(ast{1}{1},'types.Symbol') && ...
+ strcmp(ast{1}{1}.name, 'splice-unquote')
+ ret = {types.Symbol('concat'), ...
+ ast{1}{2}, ...
+ quasiquote(ast(2:end))};
+ else
+ ret = {types.Symbol('cons'), ...
+ quasiquote(ast{1}), ...
+ quasiquote(ast(2:end))};
+ end
+end
+
+function ret = is_macro_call(ast, env)
+ if iscell(ast) && isa(ast{1}, 'types.Symbol') && ...
+ ~islogical(env.find(ast{1}))
+ f = env.get(ast{1});
+ ret = isa(f,'types.Function') && f.is_macro;
+ else
+ ret = false;
+ end
+end
+
+function ret = macroexpand(ast, env)
+ while is_macro_call(ast, env)
+ mac = env.get(ast{1});
+ ast = mac.fn(ast{2:end});
+ end
+ ret = ast;
+end
+
+function ret = eval_ast(ast, env)
+ switch class(ast)
+ case 'types.Symbol'
+ ret = env.get(ast);
+ case 'cell'
+ ret = {};
+ for i=1:length(ast)
+ ret{end+1} = EVAL(ast{i}, env);
+ end
+ otherwise
+ ret = ast;
+ end
+end
+
+function ret = EVAL(ast, env)
+ while true
+ if ~iscell(ast)
+ ret = eval_ast(ast, env);
+ return;
+ end
+
+ % apply
+ ast = macroexpand(ast, env);
+ if ~iscell(ast)
+ ret = ast;
+ return;
+ end
+
+ if isa(ast{1},'types.Symbol')
+ a1sym = ast{1}.name;
+ else
+ a1sym = '_@$fn$@_';
+ end
+ switch (a1sym)
+ case 'def!'
+ ret = env.set(ast{2}, EVAL(ast{3}, env));
+ return;
+ case 'let*'
+ let_env = Env(env);
+ for i=1:2:length(ast{2})
+ let_env.set(ast{2}{i}, EVAL(ast{2}{i+1}, let_env));
+ end
+ env = let_env;
+ ast = ast{3}; % TCO
+ case 'quote'
+ ret = ast{2};
+ return;
+ case 'quasiquote'
+ ast = quasiquote(ast{2}); % TCO
+ case 'defmacro!'
+ ret = env.set(ast{2}, EVAL(ast{3}, env));
+ ret.is_macro = true;
+ return;
+ case 'macroexpand'
+ ret = macroexpand(ast{2}, env);
+ return;
+ case 'try*'
+ try
+ ret = EVAL(ast{2}, env);
+ return;
+ catch e
+ if length(ast) > 2 && strcmp(ast{3}{1}.name, 'catch*')
+ if isa(e, 'types.MalException')
+ exc = e.obj;
+ else
+ exc = e.message;
+ end
+ ret = EVAL(ast{3}{3}, Env(env, {ast{3}{2}}, {exc}));
+ return;
+ else
+ throw(e);
+ end
+ end
+ case 'do'
+ el = eval_ast(ast(2:end-1), env);
+ ast = ast{end}; % TCO
+ case 'if'
+ cond = EVAL(ast{2}, env);
+ if strcmp(class(cond), 'types.Nil') || ...
+ (islogical(cond) && cond == false)
+ if length(ast) > 3
+ ast = ast{4}; % TCO
+ else
+ ret = types.nil;
+ return;
+ end
+ else
+ ast = ast{3}; % TCO
+ end
+ case 'fn*'
+ fn = @(varargin) EVAL(ast{3}, Env(env, ast{2}, varargin));
+ ret = types.Function(fn, ast{3}, env, ast{2});
+ return;
+ otherwise
+ el = eval_ast(ast, env);
+ f = el{1};
+ args = el(2:end);
+ if isa(f, 'types.Function')
+ env = Env(f.env, f.params, args);
+ ast = f.ast; % TCO
+ else
+ ret = f(args{:});
+ return
+ end
+ end
+ end
+end
+
+% print
+function ret = PRINT(ast)
+ ret = printer.pr_str(ast, true);
+end
+
+% REPL
+function ret = rep(str, env)
+ ret = PRINT(EVAL(READ(str), env));
+end
+
+function main(args)
+ repl_env = Env(false);
+
+ % core.m: defined using matlab
+ ns = core.ns(); ks = ns.keys();
+ for i=1:length(ks)
+ k = ks{i};
+ repl_env.set(types.Symbol(k), ns(k));
+ end
+ repl_env.set(types.Symbol('eval'), @(a) EVAL(a, repl_env));
+ repl_env.set(types.Symbol('*ARGV*'), args(2:end));
+
+ % core.mal: defined using the langauge itself
+ rep('(def! *host-language* "matlab")', repl_env);
+ 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);
+
+ if ~isempty(args)
+ rep(strcat('(load-file "', args{1}, '")'), repl_env);
+ quit;
+ end
+
+ %cleanObj = onCleanup(@() disp('*** here1 ***'));
+ rep('(println (str "Mal [" *host-language* "]"))', repl_env);
+ while (true)
+ line = input('user> ', 's');
+ 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));
+ else
+ fprintf('Error: %s\n', err.message);
+ end
+ fprintf('%s\n', getReport(err, 'extended'));
+ end
+ end
+end
diff --git a/perf.mal b/perf.mal
index 79e6230..94da2ff 100644
--- a/perf.mal
+++ b/perf.mal
@@ -1,7 +1,7 @@
(defmacro! time
(fn* (exp)
- `(let* [start_FIXME (time-ms)
- ret_FIXME ~exp]
+ `(let* (start_FIXME (time-ms)
+ ret_FIXME ~exp)
(do
(prn (str "Elapsed time: " (- (time-ms) start_FIXME) " msecs"))
ret_FIXME))))