2015-02-09 08:50:12 +03:00
function step9_try ( varargin ) , main ( varargin ) , end
% read
function ret = READ ( str )
ret = reader . read_str ( str ) ;
end
% eval
function ret = is_pair ( ast )
2015-12-31 22:43:55 +03:00
ret = type_utils . sequential_Q ( ast ) && length ( ast ) > 0 ;
2015-02-09 08:50:12 +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 08:50:12 +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 08:50:12 +03:00
end
end
function ret = is_macro _call ( ast , env )
2015-12-31 22:43:55 +03:00
if type_utils . list_Q ( ast ) && isa ( ast . get ( 1 ) , ' types . Symbol ' ) && . . .
2015-02-10 08:20:23 +03:00
~ 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 ;
2015-02-09 08:50:12 +03:00
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 08:50:12 +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 08:50:12 +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 08:50:12 +03:00
end
otherwise
ret = ast ;
end
end
function ret = EVAL ( ast , env )
while true
2015-02-10 10:51:28 +03:00
% fprintf ( ' EVAL : % s \ n ' , printer . pr_str ( ast , true ) ) ;
2015-12-31 22:43:55 +03:00
if ~ type_utils . list_Q ( ast )
2015-02-09 08:50:12 +03:00
ret = eval_ast ( ast , env ) ;
return ;
end
% apply
2016-04-03 01:26:53 +03:00
if length ( ast ) = = 0
ret = ast ;
return ;
end
2015-02-09 08:50:12 +03:00
ast = macroexpand ( ast , env ) ;
2015-12-31 22:43:55 +03:00
if ~ type_utils . list_Q ( ast )
2016-01-26 23:16:20 +03:00
ret = eval_ast ( ast , env ) ;
2015-02-09 08:50:12 +03:00
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 08:50:12 +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 08:50:12 +03:00
return ;
case ' let * '
2015-12-31 22:43:55 +03:00
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 08:50:12 +03:00
end
env = let_env ;
2015-02-10 08:20:23 +03:00
ast = ast . get ( 3 ) ; % TCO
2015-02-09 08:50:12 +03:00
case ' quote '
2015-02-10 08:20:23 +03:00
ret = ast . get ( 2 ) ;
2015-02-09 08:50:12 +03:00
return ;
case ' quasiquote '
2015-02-10 08:20:23 +03:00
ast = quasiquote ( ast . get ( 2 ) ) ; % TCO
2015-02-09 08:50:12 +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 08:50:12 +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 08:50:12 +03:00
return ;
case ' try * '
try
2015-02-10 08:20:23 +03:00
ret = EVAL ( ast . get ( 2 ) , env ) ;
2015-02-09 08:50:12 +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-12-31 22:43:55 +03:00
if strcmp ( e . identifier , ' MalException : object ' )
if exist ( ' OCTAVE_VERSION ' , ' builtin ' ) ~ = 0
global error_object ;
exc = error_object ;
else
exc = e . obj ;
end
2015-02-09 08:50:12 +03:00
else
exc = e . message ;
end
2015-12-31 22:43:55 +03:00
catch_env = Env ( { env } , types . List ( ast . get ( 3 ) . get ( 2 ) ) , . . .
2015-02-10 08:20:23 +03:00
types . List ( exc ) ) ;
ret = EVAL ( ast . get ( 3 ) . get ( 3 ) , catch_env ) ;
2015-02-09 08:50:12 +03:00
return ;
else
Test uncaught throw, catchless try* . Fix 46 impls.
Fixes made to: ada, c, chuck, clojure, coffee, common-lisp, cpp,
crystal, d, dart, elm, erlang, es6, factor, fsharp, gnu-smalltalk,
groovy, guile, haxe, hy, js, livescript, matlab, miniMAL, nasm, nim,
objc, objpascal, ocaml, perl, perl6, php, plsql, ps, python, r,
rpython, ruby, scheme, swift3, tcl, ts, vb, vimscript, wasm, yorick.
Catchless try* test is an optional test. Not all implementations
support catchless try* but a number were fixed so they at least don't
crash on catchless try*.
2018-12-03 22:20:44 +03:00
rethrow ( e ) ;
2015-02-09 08:50:12 +03:00
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 08:50:12 +03:00
case ' if '
2015-02-10 08:20:23 +03:00
cond = EVAL ( ast . get ( 2 ) , env ) ;
2015-02-09 08:50:12 +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 08:50:12 +03:00
else
2015-12-31 22:43:55 +03:00
ret = type_utils . nil ;
2015-02-09 08:50:12 +03:00
return ;
end
else
2015-02-10 08:20:23 +03:00
ast = ast . get ( 3 ) ; % TCO
2015-02-09 08:50:12 +03:00
end
case ' fn * '
2015-12-31 22:43:55 +03:00
fn = @ ( varargin ) EVAL ( ast . get ( 3 ) , Env ( { env } , ast . get ( 2 ) , . . .
2015-02-10 08:20:23 +03:00
types . List ( varargin { : } ) ) ) ;
ret = types . Function ( fn , ast . get ( 3 ) , env , ast . get ( 2 ) ) ;
2015-02-09 08:50:12 +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 08:50:12 +03:00
if isa ( f , ' types . Function ' )
2015-12-31 22:43:55 +03:00
env = Env ( { f . env } , f . params , args ) ;
2015-02-09 08:50:12 +03:00
ast = f . ast ; % TCO
else
2015-02-10 08:20:23 +03:00
ret = f ( args . data { : } ) ;
2015-02-09 08:50:12 +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 )
2015-12-31 22:43:55 +03:00
repl_env = Env ( ) ;
2015-02-09 08:50:12 +03:00
% 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 08:50:12 +03:00
% core . mal : defined using the langauge itself
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 )
2015-02-10 10:51:28 +03:00
rep ( sprintf ( ' ( load - file "%s" ) ' , args { 1 } ) , repl_env ) ;
2015-02-09 08:50:12 +03:00
quit ;
end
% cleanObj = onCleanup ( @ ( ) disp ( ' * * * here1 * * * ' ) ) ;
while ( true )
2015-12-31 22:43:55 +03:00
try
line = input ( ' user > ' , ' s ' ) ;
catch err
return
end
2015-02-09 08:50:12 +03:00
if strcmp ( strtrim ( line ) , ' ' ) , continue , end
try
fprintf ( ' % s \ n ' , rep ( line , repl_env ) ) ;
catch err
2015-12-31 22:43:55 +03:00
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
2015-02-09 08:50:12 +03:00
else
fprintf ( ' Error : % s \ n ' , err . message ) ;
end
2015-12-31 22:43:55 +03:00
type_utils . print_stack ( err ) ;
2015-02-09 08:50:12 +03:00
end
end
end