2015-02-09 09:23:10 +03:00
function stepA_interop ( varargin ) , main ( varargin ) , end
% read
function ret = READ ( str )
ret = reader . read_str ( str ) ;
end
% eval
function ret = is_pair ( ast )
2015-02-10 08:20:23 +03:00
ret = types . sequential_Q ( ast ) && length ( ast ) > 0 ;
2015-02-09 09:23:10 +03:00
end
function ret = quasiquote ( ast )
if ~ is_pair ( ast )
2015-02-10 08:20:23 +03:00
ret = types . List ( types . Symbol ( ' quote ' ) , ast ) ;
elseif isa ( ast . get ( 1 ) , ' types . Symbol ' ) && . . .
strcmp ( ast . get ( 1 ) . name , ' unquote ' )
ret = ast . get ( 2 ) ;
elseif is_pair ( ast . get ( 1 ) ) && . . .
isa ( ast . get ( 1 ) . get ( 1 ) , ' types . Symbol ' ) && . . .
strcmp ( ast . get ( 1 ) . get ( 1 ) . name , ' splice - unquote ' )
ret = types . List ( types . Symbol ( ' concat ' ) , . . .
ast . get ( 1 ) . get ( 2 ) , . . .
quasiquote ( ast . slice ( 2 ) ) ) ;
2015-02-09 09:23:10 +03:00
else
2015-02-10 08:20:23 +03:00
ret = types . List ( types . Symbol ( ' cons ' ) , . . .
quasiquote ( ast . get ( 1 ) ) , . . .
quasiquote ( ast . slice ( 2 ) ) ) ;
2015-02-09 09:23:10 +03:00
end
end
function ret = is_macro _call ( ast , env )
2015-02-10 08:20:23 +03:00
if types . list_Q ( ast ) && isa ( ast . get ( 1 ) , ' types . Symbol ' ) && . . .
~ islogical ( env . find ( ast . get ( 1 ) ) )
f = env . get ( ast . get ( 1 ) ) ;
2015-02-09 09:23:10 +03:00
ret = isa ( f , ' types . Function ' ) && f . is_macro ;
else
ret = false ;
end
end
function ret = macroexpand ( ast , env )
while is_macro _call ( ast , env )
2015-02-10 08:20:23 +03:00
mac = env . get ( ast . get ( 1 ) ) ;
args = ast . slice ( 2 ) ;
ast = mac . fn ( args . data { : } ) ;
2015-02-09 09:23:10 +03:00
end
ret = ast ;
end
function ret = eval_ast ( ast , env )
switch class ( ast )
case ' types . Symbol '
ret = env . get ( ast ) ;
2015-02-10 08:20:23 +03:00
case ' types . List '
ret = types . List ( ) ;
2015-02-09 09:23:10 +03:00
for i = 1 : length ( ast )
2015-02-10 08:20:23 +03:00
ret . append ( EVAL ( ast . get ( i ) , env ) ) ;
end
case ' types . Vector '
ret = types . Vector ( ) ;
for i = 1 : length ( ast )
ret . append ( EVAL ( ast . get ( i ) , env ) ) ;
end
case ' types . HashMap '
ret = types . HashMap ( ) ;
ks = ast . keys ( ) ;
for i = 1 : length ( ks )
k = ks { i } ;
ret . set ( EVAL ( k , env ) , EVAL ( ast . get ( k ) , env ) ) ;
2015-02-09 09:23:10 +03:00
end
otherwise
ret = ast ;
end
end
function ret = EVAL ( ast , env )
while true
2015-02-10 08:20:23 +03:00
if ~ types . list_Q ( ast )
2015-02-09 09:23:10 +03:00
ret = eval_ast ( ast , env ) ;
return ;
end
% apply
ast = macroexpand ( ast , env ) ;
2015-02-10 08:20:23 +03:00
if ~ types . list_Q ( ast )
2015-02-09 09:23:10 +03:00
ret = ast ;
return ;
end
2015-02-10 08:20:23 +03:00
if isa ( ast . get ( 1 ) , ' types . Symbol ' )
a1sym = ast . get ( 1 ) . name ;
2015-02-09 09:23:10 +03:00
else
a1sym = ' _ @ $ fn $ @ _ ' ;
end
switch ( a1sym )
case ' def ! '
2015-02-10 08:20:23 +03:00
ret = env . set ( ast . get ( 2 ) , EVAL ( ast . get ( 3 ) , env ) ) ;
2015-02-09 09:23:10 +03:00
return ;
case ' let * '
let_env = Env ( env ) ;
2015-02-10 08:20:23 +03:00
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 ) ) ;
2015-02-09 09:23:10 +03:00
end
env = let_env ;
2015-02-10 08:20:23 +03:00
ast = ast . get ( 3 ) ; % TCO
2015-02-09 09:23:10 +03:00
case ' quote '
2015-02-10 08:20:23 +03:00
ret = ast . get ( 2 ) ;
2015-02-09 09:23:10 +03:00
return ;
case ' quasiquote '
2015-02-10 08:20:23 +03:00
ast = quasiquote ( ast . get ( 2 ) ) ; % TCO
2015-02-09 09:23:10 +03:00
case ' defmacro ! '
2015-02-10 08:20:23 +03:00
ret = env . set ( ast . get ( 2 ) , EVAL ( ast . get ( 3 ) , env ) ) ;
2015-02-09 09:23:10 +03:00
ret . is_macro = true ;
return ;
case ' macroexpand '
2015-02-10 08:20:23 +03:00
ret = macroexpand ( ast . get ( 2 ) , env ) ;
2015-02-09 09:23:10 +03:00
return ;
case ' try * '
try
2015-02-10 08:20:23 +03:00
ret = EVAL ( ast . get ( 2 ) , env ) ;
2015-02-09 09:23:10 +03:00
return ;
catch e
2015-02-10 08:20:23 +03:00
if length ( ast ) > 2 && strcmp ( ast . get ( 3 ) . get ( 1 ) . name , ' catch * ' )
2015-02-09 09:23:10 +03:00
if isa ( e , ' types . MalException ' )
exc = e . obj ;
else
exc = e . message ;
end
2015-02-10 08:20:23 +03:00
catch_env = Env ( env , types . List ( ast . get ( 3 ) . get ( 2 ) ) , . . .
types . List ( exc ) ) ;
ret = EVAL ( ast . get ( 3 ) . get ( 3 ) , catch_env ) ;
2015-02-09 09:23:10 +03:00
return ;
else
throw ( e ) ;
end
end
case ' do '
2015-02-10 08:20:23 +03:00
el = eval_ast ( ast . slice ( 2 , length ( ast ) -1 ) , env ) ;
ast = ast . get ( length ( ast ) ) ; % TCO
2015-02-09 09:23:10 +03:00
case ' if '
2015-02-10 08:20:23 +03:00
cond = EVAL ( ast . get ( 2 ) , env ) ;
2015-02-09 09:23:10 +03:00
if strcmp ( class ( cond ) , ' types . Nil ' ) || . . .
( islogical ( cond ) && cond = = false )
if length ( ast ) > 3
2015-02-10 08:20:23 +03:00
ast = ast . get ( 4 ) ; % TCO
2015-02-09 09:23:10 +03:00
else
ret = types . nil ;
return ;
end
else
2015-02-10 08:20:23 +03:00
ast = ast . get ( 3 ) ; % TCO
2015-02-09 09:23:10 +03:00
end
case ' fn * '
2015-02-10 08:20:23 +03:00
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 ) ) ;
2015-02-09 09:23:10 +03:00
return ;
otherwise
el = eval_ast ( ast , env ) ;
2015-02-10 08:20:23 +03:00
f = el . get ( 1 ) ;
args = el . slice ( 2 ) ;
2015-02-09 09:23:10 +03:00
if isa ( f , ' types . Function ' )
env = Env ( f . env , f . params , args ) ;
ast = f . ast ; % TCO
else
2015-02-10 08:20:23 +03:00
ret = f ( args . data { : } ) ;
2015-02-09 09:23:10 +03:00
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 ) ) ;
2015-02-10 08:20:23 +03:00
rest_args = args ( 2 : end ) ;
repl_env . set ( types . Symbol ( ' * ARGV * ' ) , types . List ( rest_args { : } ) ) ;
2015-02-09 09:23:10 +03:00
% 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