1:- use_module(transpiler).    2:- set_prolog_flag(double_quotes,chars).    3:- initialization(main).    4:- use_module(library(prolog_stack)).    5:- use_module(library(error)).    6
    7user:prolog_exception_hook(Exception, Exception, Frame, _) :-
    8    (   Exception = error(Term)
    9    ;   Exception = error(Term, _)),
   10    get_prolog_backtrace(Frame, 20, Trace),
   11    format(user_error, 'Error: ~p', [Term]), nl(user_error),
   12    print_prolog_backtrace(user_error, Trace), nl(user_error), fail.
   13
   14%list_of_langs(['javascript','java','c#','php','lua','ruby','perl','python','haxe','c++','c','erlang','prolog']).
   15list_of_langs(['javascript','php','java','ruby']).
   16
   17main :-
   18	read_file_to_codes('javascript_source.js',Input,[]),
   19    list_of_langs(Langs),
   20    %test_statement(Input,python,'java').
   21    %Statements_to_test = [Input,"b = math.acos(3)","in_arr = 3 in [1,2,3]","randomly_chosen = random.choice([1,2,3])", "str1 = str2.join([\"hi\",\"hi\"])", "str_arr = str1.split(str2)", "a_string += \"stuff\"","a_string=str1.replace(str2,str3)","bool_var = (3 != 4)","string_var = (\"3\" != \"4\")","a+=1","a*=1","a-=1","a*=1"],
   22    %Statements_to_test = [Input,"b = (3)**(2)","z=math.sqrt(1)","a=math.asin(3)","a=math.acos(3)","a=math.atan(3)"],
   23    Statements_to_test = [Input],
   24    profile(test_statements_in_langs(Statements_to_test,'javascript',Langs)).
   25
   26write_to_file(Text,File_name) :-
   27	open(File_name,write,Stream),
   28	write(Stream,Text),
   29	close(Stream).
   30
   31test_statements_in_langs(Statements,Lang1,[A]) :-
   32	test_statements(Statements,Lang1,A).
   33
   34test_statements_in_langs(Statements,Lang1,[A|B]) :-
   35	test_statements(Statements,Lang1,A),!,test_statements_in_langs(Statements,Lang1,B).
   36
   37test_statements([A],Lang1,Lang2) :-
   38	test_statement(A,Lang1,Lang2).
   39test_statements([A|B],Lang1,Lang2) :-
   40	test_statement(A,Lang1,Lang2),!,test_statements(B,Lang1,Lang2).
   41    
   42test_statement(Input,Lang1,Lang2) :-
   43	writeln('\n'),
   44	writeln([translate,Lang1,to,Lang2]),
   45    atom_codes(Input1,Input),
   46    atom_chars(Input1,Input2),
   47    transpiler:translate(Lang1,Lang2,Input2,Output),!,atom_chars(Output1,Output),writeln(Output1),write_output_to_file(Lang2,Output1).
   48
   49write_output_to_file(perl,Text) :-
   50	write_to_file(Text,'perl_source.pl').
   51write_output_to_file(java,Text) :-
   52	write_to_file(Text,'java_source.java').
   53write_output_to_file(javascript,Text) :-
   54	write_to_file(Text,'javascript_source.js').
   55write_output_to_file(php,Text) :-
   56	write_to_file(Text,'php_source.php').
   57write_output_to_file(lua,Text) :-
   58	write_to_file(Text,'lua_source.lua').
   59write_output_to_file('c++',Text) :-
   60	write_to_file(Text,'cpp_source.cpp').
   61write_output_to_file('scala',Text) :-
   62	write_to_file(Text,'scala_source.txt').
   63write_output_to_file('erlang',Text) :-
   64	write_to_file(Text,'erlang_source.txt').
   65write_output_to_file('c',Text) :-
   66	write_to_file(Text,'c_source.c').
   67write_output_to_file('ruby',Text) :-
   68	write_to_file(Text,'ruby_source.rb')