API tools faq
paste
Advertisement
logicmoo

wam2cs

logicmoo
Dec 4th, 2017
548
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Prolog 89.87 KB | None | 0 0
raw download clone embed print report
  1. %
  2. % @(#) plcs.pl
  3. % A Translator from LLP/Prolog to CSharp
  4. % @language system SICStus Prolog 2.1
  5. %
  6.  
  7. % @author Mutsunori Banbara
  8. %         banbara@pascal.seg.kobe-u.ac.jp
  9. %         Nara National College of Technology
  10. % @author Naoyuki Tamura
  11. %         tamura@kobe-u.ac.jp
  12. %         Faculty of Engineering, Kobe University
  13.  
  14. % Modified into a Translator from LLP/Prolog to C#
  15. % by      Jonathan Cook
  16. %         jjc@dcs.ed.ac.uk
  17. %         Division of Informatics, University of Edinburgh
  18.  
  19. :- op(1200, fx,  (forall)).
  20. :- op(1190, xfx, (\)).
  21. :- op(1170, xfx, (:-)).
  22. :- op(1170, xfx, (-->)).
  23. :- op(1170,  fx, (:-)).
  24. :- op(1170,  fx, (?-)).
  25. :- op(1150,  fx, (resource)).
  26. :- op(1060, xfy, (&)).
  27. :- op( 950, xfy, (-<>)).
  28. :- op( 950, xfy, (=>)).
  29. :- op( 900,  fy, (!)).
  30. :- op( 500, yfx, (#)).
  31.  
  32. :- dynamic '$internal_clause'/2.
  33. :- dynamic '$internal_predicates'/2.
  34. :- dynamic '$dynamic_predicates'/2.
  35. :- dynamic '$resource_predicates'/2.
  36. :- dynamic '$fco_predicates'/2.
  37. :- dynamic '$file_name'/1.
  38. :- dynamic '$dummy_counter'/1.
  39. :- dynamic '$res_counter'/1.
  40.  
  41. % version information
  42. '$version'('P# 0.1, on March 18 2002;  Prolog Cafe 0.44, on November 12 1999').
  43.  
  44. /*===============================================================
  45.     Main
  46. ===============================================================*/
  47. plcs(File) :-
  48.     '$list_to_string'([File,'.pl'], In),
  49.     write('{translating '), write(In), write(' into C#...}'), nl,
  50.     statistics(runtime, _),
  51.     '$plcs_init'(File),
  52.     '$read_in_program'(In),
  53.     '$compile_all_predicates',
  54.     statistics(runtime, [_,T]),
  55.     write('{'), write(In), write(' translated, '),
  56.     write(T), write(' msec}'), nl.
  57.  
  58. '$plcs_init'(File) :-
  59.     retractall('$file_name'(_)),
  60.     retractall('$dummy_counter'(_)),
  61.     retractall('$internal_clause'(_,_)),
  62.     retractall('$internal_predicates'(_,_)),
  63.     retractall('$dynamic_predicates'(_,_)),
  64.     retractall('$resource_predicates'(_,_)),
  65.     retractall('$fco_predicates'(_,_)),
  66.     retractall('$res_counter'(_)),
  67.     assert('$file_name'(File)),
  68.     assert('$dummy_counter'(0)),
  69.     assert('$res_counter'(0)).
  70.  
  71. % Read in Program
  72. '$read_in_program'(File) :-
  73.     open(File, read, In),
  74.     repeat,
  75.       read(In, X),
  76.       '$assert_clause'(X),
  77.     X == end_of_file,
  78.     !,
  79.     close(In).
  80.  
  81. '$assert_clause'(end_of_file) :- !.
  82. '$assert_clause'((:- resource G)) :- !, %for LLP
  83.     '$assert_resource_predicate'(G).
  84. '$assert_clause'((:- dynamic G)) :- !,
  85.     '$assert_dynamic'(G).
  86. '$assert_clause'((:- mode _G)) :- !.
  87. '$assert_clause'((:- multifile _G)) :- !.
  88. '$assert_clause'((:- public _G)) :- !.
  89. '$assert_clause'((:- block _G)) :- !.
  90. '$assert_clause'((:- meta_predicate _G)) :- !.
  91. '$assert_clause'((:- G)) :- !, call(G).
  92. '$assert_clause'(Clause0) :-
  93.     '$preprocess'(Clause0, Clause), % DCG, ;$B$N:o=|$J$I(B
  94.     '$assert_cls'(Clause).
  95.  
  96. '$assert_cls'((Head :- Body)) :- !,
  97.     '$assert_predicate'(Head),
  98.     assert('$internal_clause'(Head, Body)).
  99. '$assert_cls'(Head) :- !,
  100.     '$assert_predicate'(Head),
  101.     assert('$internal_clause'(Head, true)).
  102.  
  103. '$assert_predicate'(Head) :-
  104.     functor(Head, Functor, Arity),
  105.     clause('$internal_predicates'(Functor, Arity), _),
  106.     !.
  107. '$assert_predicate'(Head) :-
  108.     functor(Head, Functor, Arity),
  109.     assert('$internal_predicates'(Functor, Arity)).
  110.  
  111. % DCG$B$NJQ49$H(B";"$B$N:o=|(B
  112. '$preprocess'(Clause0, Clause) :-
  113.     expand_term(Clause0, Clause1),
  114.     '$eliminate_disj'(Clause1, Clause, DummyClauses),
  115.     '$assert_dummy_clauses'(DummyClauses).
  116.  
  117. '$assert_dummy_clauses'([]) :- !.
  118. '$assert_dummy_clauses'([C|Cs]) :-
  119.     '$assert_clause'(C),
  120.     '$assert_dummy_clauses'(Cs).
  121.  
  122. % resource declaration$B$N=hM}(B
  123. '$assert_resource_predicate'((G1,G2)) :- !,
  124.     '$assert_resource_predicate'(G1),
  125.     '$assert_resource_predicate'(G2).
  126. '$assert_resource_predicate'(G) :- G = F/A, !,
  127.     functor(Head, F, A),
  128.     '$assert_res'(F,A),
  129.     '$assert_predicate'(Head).
  130. '$assert_resource_predicate'(G) :-
  131.     '$message'([G,is,invalid,resource,declaration]),
  132.     fail.
  133.  
  134. '$assert_res'(F,A) :-
  135.     clause('$resource_predicates'(F, A), _), !.
  136. '$assert_res'(F,A) :-
  137.     assert('$resource_predicates'(F, A)).
  138.  
  139. % dynamic declaration$B$N=hM}(B
  140. '$assert_dynamic'((G1,G2)) :- !,
  141.     '$assert_dynamic'(G1),
  142.     '$assert_dynamic'(G2).
  143. '$assert_dynamic'(G) :- G = F/A,!,
  144.     functor(Head, F, A),
  145.     '$assert_dynamic_predicate'(F/A),
  146.     '$assert_cls'((Head :- clause(Head, Goal), call(Goal))).
  147. '$assert_dynamic'(G) :-
  148.     '$message'([G,is,invalid,dynamic,declaration]),
  149.     fail.
  150.  
  151. '$assert_dynamic_predicate'(F/A) :-
  152.     clause('$dynamic_predicates'(F, A), _),
  153.     !.
  154. '$assert_dynamic_predicate'(F/A) :-
  155.     assert('$dynamic_predicates'(F, A)).
  156.  
  157. /*===============================================================
  158.     $B%W%m%0%i%`Cf$N(B";"$B$r:o=|$9$k%k!<%A%s(B
  159. ===============================================================*/
  160. /*
  161.   a :- b;c $B$O(B
  162.   a :- b.
  163.   a :- c.
  164.   $B$N#2$D$N@a$KJQ49$5$l$k!#$^$?F1;~$K!"(B
  165.   (C1 -> C2)        $B$O(B ((C1,!,C2) ; fail)  $B$K(B
  166.   ((C1 -> C2) ; C3) $B$O(B ((C1,!,C2) ; C3)    $B$K(B
  167.   not(C)            $B$O(B ((C,!,fail) ; true) $B$K(B
  168.   \+(C)             $B$O(B ((C,!,fail) ; true) $B$K(B
  169.   $B$*$N$*$NJQ49$7$?8e!"(B";"$B$r:o=|$9$k!#(B
  170.  
  171.   $BCm0U(B
  172.   ====
  173.   $B%@%_!<@a$K(B";"$B$,4^$^$l$F$$$F$b!"(B'$assert_clause'/1$B$G$^$?:o=|$5$l$k(B
  174.   $B$N$GLdBj$J$$(B
  175. */
  176.  
  177. '$eliminate_disj'(Cl, NewCl, DummyCls) :-
  178.     '$extract_disj'(Cl, NewCl, Disjs, []),
  179.     '$treat_disj'(Disjs, DummyCls, []).
  180.  
  181. '$extract_disj'(Cl, (H :- NewB)) --> {Cl = (H :- B)}, !,
  182.     '$extract_disj'(B, NewB, Cl).
  183. '$extract_disj'(Cl, Cl) --> !.
  184.  
  185. '$extract_disj'((G1&G2), (NewG1&NewG2), Cl) --> !,
  186.     '$extract_disj'(G1, NewG1, Cl),
  187.     '$extract_disj'(G2, NewG2, Cl).
  188. '$extract_disj'((G1,G2), (NewG1,NewG2), Cl) --> !,
  189.     '$extract_disj'(G1, NewG1, Cl),
  190.     '$extract_disj'(G2, NewG2, Cl).
  191. '$extract_disj'((R-<>G), (R-<>NewG), Cl) --> !,
  192.     '$extract_disj'(G, NewG, Cl).
  193. '$extract_disj'((R =>G), (R =>NewG), Cl) --> !,
  194.     '$extract_disj'(G, NewG, Cl).
  195. '$extract_disj'( !G, !NewG, Cl) --> !,
  196.     '$extract_disj'(G, NewG, Cl).
  197. '$extract_disj'(G, NewG, Cl) --> {'$is_disj'(G, DisjG)}, !,
  198.     {'$dummy_counter'(N)},
  199.     [disj(DisjG, N, NewG, Cl)],
  200.     {retract('$dummy_counter'(_))},
  201.     {N1 is N+1},
  202.     {assert('$dummy_counter'(N1))}.
  203. '$extract_disj'(G, G, _) --> !.
  204.  
  205. '$is_disj'((C1->C2), ((C1,!,C2);fail)) :- !.
  206. '$is_disj'(((C1->C2);C3), ((C1,!,C2);C3)) :- !.
  207. '$is_disj'((C1;C2), (C1;C2)) :- !.
  208. '$is_disj'(not(C),((C,!,fail);true)) :- !.
  209. '$is_disj'(\+(C),((C,!,fail);true)).
  210.  
  211. '$treat_disj'([]) --> !.
  212. '$treat_disj'([disj((A;B),N,X,C)|Disjs]) -->
  213.     {'$variables'((A;B), Vars)},
  214.     {'$variables'(C, CVars)},
  215.     {'$intersect_vars'(Vars, CVars, Args)},
  216.     {'$make_dummy_name'(N,Name)},
  217.     {X =.. [Name|Args]},
  218.     '$make_dummy_clauses'((A;B), X),
  219.     '$treat_disj'(Disjs).
  220.  
  221. '$intersect_vars'(V1,V2,Out) :-
  222.     sort(V1,Sorted1),
  223.     sort(V2,Sorted2),
  224.     '$intersect_sorted_vars'(Sorted1,Sorted2,Out).
  225.  
  226. '$intersect_sorted_vars'([],_,[]) :- !.
  227. '$intersect_sorted_vars'(_,[],[]).
  228. '$intersect_sorted_vars'([X|Xs],[Y|Ys],[X|Rs]) :- X == Y, !,
  229.     '$intersect_sorted_vars'(Xs,Ys,Rs).
  230. '$intersect_sorted_vars'([X|Xs],[Y|Ys],Rs) :- X @< Y, !,
  231.     '$intersect_sorted_vars'(Xs,[Y|Ys],Rs).
  232. '$intersect_sorted_vars'([X|Xs],[Y|Ys],Rs) :- X @> Y, !,
  233.     '$intersect_sorted_vars'([X|Xs],Ys,Rs).
  234.  
  235. '$make_dummy_name'(N,Name) :- integer(N), '$file_name'(File),!,
  236.     '$list_to_string'(['$dummy_', File, '_', N], Name).
  237.  
  238. '$make_dummy_clauses'((A;B), X) --> !,
  239.     '$make_dummy_clauses'(A,X),
  240.     '$make_dummy_clauses'(B,X).
  241. '$make_dummy_clauses'(A, X) -->
  242.     {copy_term((X :- A), DummyCl)},
  243.     [DummyCl].
  244.  
  245. /*===============================================================
  246.     $B%W%m%0%i%`$N%3%s%Q%$%k(B
  247. ===============================================================*/
  248. /*
  249.  $BF1$8=R8lL>!"%"%j%F%#$r$b$D(BProlog$B$N@a$r%/%i%9$N=89g$K%H%i%s%9%l!<%H$9$k!#(B
  250.  $B8=:_$N%H%i%s%9%l!<%HJ}<0$O(B
  251.     Prolog(*.pl)  -->  WAM-like$B$JCf4V8@8l(B(*.asm)  -->  Java(*.cs)
  252.  $B$G$"$k!#(B
  253. */
  254. '$compile_all_predicates' :-
  255.     clause('$internal_predicates'(Functor, Arity), _),
  256.     '$compile_predicate'(Functor, Arity, Instructions, []),
  257.     '$create_class_name'(Functor/Arity, Class),
  258.     /* $BCf4V%3!<%I(B */
  259.     %'$list_to_string'([Class, '.asm'], AsmFile),
  260.         %open(AsmFile, write, AsmOut),
  261.     %'$write_intermediate'(AsmOut, Instructions), nl(AsmOut),
  262.     %close(AsmOut),
  263.     /* Java$B%3!<%I$N=PNO(B */
  264.     '$create_filename'(Functor/Arity, Filename), % JJC
  265.         '$list_to_string'([Filename, '.cs'], CsFile),
  266.     open(CsFile, write, CsOut),
  267.     '$generate_cs'(CsOut, Instructions), nl(CsOut),
  268.     close(CsOut),
  269.     fail.
  270. '$compile_all_predicates'.
  271.  
  272. /*===============================================================
  273.     $B%j%=!<%9$N%3%s%Q%$%k(B
  274. ===============================================================*/
  275. '$compile_resource'(H, B, Vs, FA) :-
  276.     '$compile_res_pred'(FA, (H :- B), Vs, Instructions0, []),
  277.     '$flatten_code'(Instructions0, Instructions, []),
  278.     '$create_class_name'(FA, Class),
  279.     /* $BCf4V%3!<%I$N=PNO(B */
  280.     %'$list_to_string'([Class, '.asm'], AsmFile),
  281.     %open(AsmFile, write, AsmOut),
  282.     %'$write_intermediate'(AsmOut, Instructions), nl(AsmOut),
  283.     %close(AsmOut),
  284.     /* Java$B%3!<%I$N=PNO(B */
  285.     '$create_filename'( FA, Filename ), %JJC
  286.     '$list_to_string'([Filename, '.cs'], CsFile), %JJC
  287.     open(CsFile, write, CsOut),
  288.     '$generate_cs'(CsOut, Instructions), nl(CsOut),
  289.     close(CsOut),
  290.     !.
  291.  
  292. '$compile_res_pred'(FA, ResCl, Vs) -->
  293.     {FA = '$res'(F/A, _N)},
  294.     {length(Vs, M)},
  295.     {N1 is M + A},
  296.     [comment(ResCl)],
  297.     [FA: []],
  298.     [StaticResPred],
  299.     [StaticCode],
  300.     [constructor(FA)],
  301.     [exec_method(F/A, [AVar,PVar], res(N1), ExecCode)],
  302.     [extra_methods(FA)],
  303.         {'$compile_res_clause'(ResCl, Vs, StaticCode, LocalVars, ExecCode, [])},
  304.     {'$gather_static_res_pred'(ExecCode, StaticResPred)},
  305.     {LocalVars = [AVar, _, PVar]}.
  306.  
  307. '$gather_static_res_pred'([], []) :- !.
  308. '$gather_static_res_pred'([put_closure(U,_,_)|Cs], [put_static_pred(U)|S]) :- !,
  309.     '$gather_static_res_pred'(Cs, S).
  310. '$gather_static_res_pred'([_|Cs], S) :-
  311.     '$gather_static_res_pred'(Cs, S).
  312.  
  313. /*===============================================================
  314.     $B%j%=!<%9@a$N%3%s%Q%$%k(B
  315. ===============================================================*/
  316. '$compile_res_clause'((Head0 :- Body0), Vs, Static, Local) -->
  317.     {'$transform'((Head0 :- Body0), (Head :- Body))},  
  318.     {'$precompile_r'(Head, Body, Vs, Code)},
  319.          '$compile_chunks'(Code, TermInfo),
  320.     {'$compile_ground'(TermInfo, Local, Static, [])},
  321.     !.
  322. '$compile_res_clause'(ResCl, _, _, _) -->
  323.     {'$message'([compilation,of,resource, ResCl,failed])},
  324.     {fail}.
  325.  
  326. '$precompile_r'(Head, Body, Vs, Instrs) :-
  327.     '$precompile_head_r'(Head, Vs, Instrs0, Bs),
  328.     '$precompile_body'(Body, Bs, []),
  329.     '$flatten_code'(Instrs0, Instrs, []).
  330.  
  331. '$precompile_head_r'(Head, []) --> !,
  332.     '$precompile_head'(Head).
  333. '$precompile_head_r'(Head, Vs) -->
  334.     {Head =.. [_|Args]},
  335.     {'$append'(Args, Vs, As)},
  336.     '$precomp_head'(As, 1).
  337.  
  338. /*===============================================================
  339.     $B=R8l$N%3%s%Q%$%k(B
  340. ===============================================================*/
  341. '$compile_predicate'(Functor, Arity) -->
  342.     {functor(Head, Functor, Arity)},
  343.     {findall((Head :- Body), clause('$internal_clause'(Head, Body),_), Clauses)},
  344.     %{'$compile_pred'(Clauses, Functor/Arity, Code, [])},
  345.     {'$compile_pred'(Clauses, Functor, Arity, Code, [])},
  346.      '$flatten_code'(Code),
  347.     !.
  348.  
  349. '$compile_pred'(Clauses, Functor, Arity) -->  %$B%j%=!<%9@k8@$"$j(B
  350.     {'$resource_predicates'(Functor, Arity)},
  351.      !,
  352.      '$compile_pred_with_res'(Clauses, Functor/Arity).
  353. '$compile_pred'(Clauses, Functor, Arity) -->  %$B%j%=!<%9@k8@$J$7(B
  354.     '$compile_pred'(Clauses, Functor/Arity).
  355.  
  356. %$B%j%=!<%9@k8@$"$j$N>l9g(B
  357. '$compile_pred_with_res'([], FA) --> !,
  358.     '$generate_root_with_res'([], FA).
  359. '$compile_pred_with_res'([Clause], FA) --> !,
  360.     '$generate_root_with_res'([Clause], FA),
  361.     '$compile_one_pred'([Clause], FA).
  362. '$compile_pred_with_res'(Clauses, FA) -->
  363.     '$generate_root_with_res'(Clauses, FA),
  364.     '$compile_pred0'(Clauses, FA, 1).
  365.  
  366. %$B%j%=!<%9@k8@$J$7$N>l9g(B
  367. '$compile_pred'([], _) --> !.
  368. %'$compile_pred'([Clause], FA) --> !,
  369. %   '$generate_root'([Clause], FA),
  370. %   '$compile_one_pred'([Clause], FA).
  371. '$compile_pred'([Clause], FA) --> !,
  372.     {copy_term(Clause, Clause1)},
  373.     [comment(Clause1)],
  374.     [FA: []],
  375.     [StaticResPred],
  376.     [StaticCode],
  377.     [constructor(FA)],
  378.     [exec_method(FA, [AVar,PVar], root_one_nores, ExecCode)],
  379.     [extra_methods(FA)],
  380.     % $B@a$N%3%s%Q%$%k(B
  381.         {'$compile_clause'(Clause, StaticCode, LocalVars, ExecCode, [])},
  382.     {'$gather_static_res_pred'(ExecCode, StaticResPred)},
  383.     {LocalVars = [AVar, _, PVar]}.
  384.  
  385. '$compile_pred'(Clauses, FA) -->
  386.     %{write('start '), write(FA),nl},
  387.     '$generate_switch_nores'(Clauses, FA),
  388.     '$compile_pred0'(Clauses, FA, 1).
  389.     %{write('end   '), write(FA),nl}.
  390.  
  391. %%%%%%%%%%%%%%%%
  392.  
  393. %'$generate_switch_nores'([] , _, _, _) --> !.
  394. %'$generate_switch_nores'([_], _, _, _) --> !.
  395. '$generate_switch_nores'(Clauses, F/0) --> !,
  396.     [F/0: []],
  397.     [StaticPred],
  398.     [constructor(F/0)],
  399.     {'$select_type'(Clauses, var, 1, All)},
  400.      '$generate_noswitch_nores'(F/0, All, Sub),
  401.     {'$generate_static_pred'(F/0, All, Sub, StaticPred, [])}.
  402.  
  403. '$generate_switch_nores'(Clauses, FA) -->
  404.     [FA: []],
  405.     [StaticPred],
  406.     [constructor(FA)],
  407.     {'$select_type'(Clauses, var, 1, All)},
  408.     {LV = FA+var},
  409.     {'$generate_sw'(Clauses, int, FA, All, LI, INT, [])},
  410.     {'$generate_sw'(Clauses, con, FA, All, LC, CON, [])},
  411.     {'$generate_sw'(Clauses, str, FA, All, LS, STR, [])},
  412.     {'$generate_sw'(Clauses, lis, FA, All, LL, LIS, [])},
  413.     '$gen_switch_on_term_nores'(FA, All, SWTPred, LV, LI, LC, LS, LL),
  414.     {'$generate_static_pred'(FA, All, SWTPred, StaticPred, [])},
  415.     [INT],
  416.     [CON],
  417.     [STR],
  418.     [LIS].
  419.  
  420. '$gen_switch_on_term_nores'(FA, All, Sub, L, L, L, L, L) --> !,
  421.     '$generate_noswitch_nores'(FA, All, Sub).
  422. '$gen_switch_on_term_nores'(FA, All, [LV,LI,LC,LS,LL], LV, LI, LC, LS, LL) -->
  423.     %[constructor(FA)],
  424.     [exec_method(FA, [], root_nores, [switch_on_term(LV,LI,LC,LS,LL)])],
  425.     [extra_methods(FA)],
  426.     [LV : []],
  427.      '$generate_tries'(All, LV).
  428.  
  429. '$generate_noswitch_nores'(FA, All, [FA+sub/1]) --> !,
  430.     {All = [N|Ns]},
  431.     %[put_static_pred(FA+sub/1)],
  432.     %[constructor(FA)],
  433.     [exec_method(FA, [], root_nores, [try(FA+N, FA+sub/1)])],
  434.     [extra_methods(FA)],
  435.     [FA+sub/1 : []],
  436.     '$generate_tries2'(Ns, FA, sub, 2).
  437.  
  438. %%%%%%%%%%%%%%%%
  439.  
  440. %'$generate_root'([], _) --> !.
  441. %'$generate_root'([_], FA) --> !,
  442. %   [FA: []],
  443. %   [put_static_pred(FA+top)],
  444. %   [constructor(FA)],
  445. %   [exec_method(FA, [], root, [jump(FA+top)])],
  446. %   [extra_methods(FA)].
  447. %'$generate_root'(Clauses, FA) --> !,
  448. %   [FA: []],
  449. %   [put_static_pred(FA+top)],
  450. %   [StaticPred],
  451. %   [constructor(FA)],
  452. %   [exec_method(FA, [], root, [jump(FA+top)])],
  453. %   [extra_methods(FA)],
  454. %         '$generate_switch'(Clauses, FA, All, SWTPred), %for indexing
  455. %   {'$generate_static_pred'(FA, All, SWTPred, StaticPred, [])}.
  456.  
  457. '$generate_root_with_res'([], FA) --> !,
  458.     {FA = F/A, I is A+1},
  459.     [FA: []],
  460.     [put_static_con(F, A, functor)],
  461.         [put_static_pred('$fail')],
  462.     [put_static_pred(FA+res/0)],
  463.     [put_static_pred(FA+res/1)],
  464.     [put_static_pred(FA+res/2)],
  465.     [put_static_pred(FA+res/3)],
  466.     [constructor(FA)],
  467.     [exec_method(FA, [], root, [look_up_hash(fail),
  468.                     pickup_resource(FA,I,fail),
  469.                     has_more_resource(FA+res/1),
  470.                     try_resource(FA+res/1, FA+res/0)])],
  471.     [extra_methods(FA)],
  472.     [FA+res/0: []],
  473.     [exec_method(FA, [], try, [restore_resource,
  474.                                pickup_resource(FA,I,FA+res/2),
  475.                    has_more_resource(FA+res/3),
  476.                    retry_resource(FA+res/1, FA+res/0)])],
  477.     [FA+res/1: []],
  478.     [exec_method(FA, [], try, [consume_and_exec_closure(I)])],
  479.     [FA+res/2: []],
  480.     [exec_method(FA, [], try, [trust_resource('$fail')])],
  481.     [FA+res/3: []],
  482.     [exec_method(FA, [], try, [trust_resource(FA+res/1)])].
  483.  
  484. '$generate_root_with_res'([_], FA) --> !,
  485.     {FA = F/A, I is A+1},
  486.     [FA: []],
  487.     [put_static_con(F, A, functor)],
  488.     [put_static_pred(FA+top)],
  489.     [put_static_pred(FA+res/0)],
  490.     [put_static_pred(FA+res/1)],
  491.     [put_static_pred(FA+res/2)],
  492.     [constructor(FA)],
  493.     [exec_method(FA, [], root, [look_up_hash(FA+top),
  494.                     pickup_resource(FA,I,FA+top),
  495.                     try_resource(FA+res/1, FA+res/0)])],
  496.     [extra_methods(FA)],
  497.     [FA+res/0: []],
  498.     [exec_method(FA, [], try, [restore_resource,
  499.                                pickup_resource(FA,I,FA+res/2),
  500.                    retry_resource(FA+res/1, FA+res/0)])],
  501.     [FA+res/1: []],
  502.     [exec_method(FA, [], try, [consume_and_exec_closure(I)])],
  503.     [FA+res/2: []],
  504.     [exec_method(FA, [], try, [trust_resource(FA+top)])].
  505.  
  506. '$generate_root_with_res'(Clauses, FA) --> !,
  507.     {FA = F/A, I is A+1},
  508.     [FA: []],
  509.     [put_static_con(F, A, functor)],
  510.     [put_static_pred(FA+top)],
  511.     [put_static_pred(FA+res/0)],
  512.     [put_static_pred(FA+res/1)],
  513.     [put_static_pred(FA+res/2)],
  514.     [StaticPred],
  515.     [constructor(FA)],
  516.     [exec_method(FA, [], root, [look_up_hash(FA+top),
  517.                     pickup_resource(FA,I,FA+top),
  518.                     try_resource(FA+res/1, FA+res/0)])],
  519.     [extra_methods(FA)],
  520.          '$generate_switch'(Clauses, FA, All, SWTPred), %for indexing
  521.     {'$generate_static_pred'(FA, All, SWTPred, StaticPred, [])},
  522.     [FA+res/0: []],
  523.     [exec_method(FA, [], try, [restore_resource,
  524.                                pickup_resource(FA,I,FA+res/2),
  525.                    retry_resource(FA+res/1, FA+res/0)])],
  526.     [FA+res/1: []],
  527.     [exec_method(FA, [], try, [consume_and_exec_closure(I)])],
  528.     [FA+res/2: []],
  529.     [exec_method(FA, [], try, [trust_resource(FA+top)])].
  530.  
  531. % $B3F=R8l$N%3%s%Q%$%k(B
  532. '$compile_one_pred'([Clause], FA) -->
  533.     {copy_term(Clause, Clause1)},
  534.     [comment(Clause1)],
  535.     [FA+top: []],
  536.     [StaticResPred],
  537.     [StaticCode],
  538.     [exec_method(FA, [AVar,PVar], top, ExecCode)],
  539.     % $B@a$N%3%s%Q%$%k(B
  540.         {'$compile_clause'(Clause, StaticCode, LocalVars, ExecCode, [])},
  541.     {'$gather_static_res_pred'(ExecCode, StaticResPred)},
  542.     {LocalVars = [AVar, _, PVar]}.
  543.  
  544. '$compile_pred0'([], _, _) --> !.
  545. '$compile_pred0'([Clause|Clauses], FA, N) -->
  546.     {copy_term(Clause, Clause1)},
  547.     [comment(Clause1)],
  548.     [FA+N: []],
  549.     [StaticResPred],
  550.     [StaticCode],
  551.     [exec_method(FA, [AVar,PVar], normal, ExecCode)],
  552.     % $B@a$N%3%s%Q%$%k(B
  553.     {'$compile_clause'(Clause, StaticCode, LocalVars, ExecCode, [])},
  554.     {'$gather_static_res_pred'(ExecCode, StaticResPred)},
  555.     {LocalVars = [AVar, _, PVar]},
  556.     {M is N + 1},
  557.     '$compile_pred0'(Clauses, FA, M).
  558.  
  559. '$generate_static_pred'(FA, All, Ss)-->
  560.     {'$normal_clauses'(FA, All, Ns)},
  561.     {'$append'(Ss, Ns, Ps0)},
  562.     {sort(Ps0, Ps)},
  563.      '$gen_static_pred'(Ps).
  564.    
  565. '$gen_static_pred'([]) --> !.
  566. '$gen_static_pred'([P|Ps]) -->
  567.     [put_static_pred(P)],
  568.     '$gen_static_pred'(Ps).
  569.  
  570. '$normal_clauses'(_, [], []) :- !.
  571. '$normal_clauses'(FA, [N|Ns], [FA+N|Ps]) :-
  572.     '$normal_clauses'(FA, Ns, Ps).
  573.  
  574. /*---------------------------------------------------------------
  575.     Indexing$B$N=hM}%k!<%A%s(B
  576.   switch_on_term, try, retry, trust$BL?Na$r@8@.$9$k!#(B
  577. ---------------------------------------------------------------*/
  578.  
  579. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  580.  
  581. '$generate_switch'([] , _, _, _) --> !.
  582. '$generate_switch'([_], _, _, _) --> !.
  583. '$generate_switch'(Clauses, F/0, All, []) --> !,
  584.     [F/0+top: []],
  585.     {'$select_type'(Clauses, var, 1, All)},
  586.      '$generate_noswitch'(F/0, All).
  587. '$generate_switch'(Clauses, FA, All, SWTPred) -->
  588.     [FA+top: []],
  589.     {'$select_type'(Clauses, var, 1, All)},
  590.     [SWT],
  591.     {LV = FA+var},
  592.      '$generate_sw'(Clauses, int, FA, All, LI),
  593.      '$generate_sw'(Clauses, con, FA, All, LC),
  594.      '$generate_sw'(Clauses, str, FA, All, LS),
  595.      '$generate_sw'(Clauses, lis, FA, All, LL),
  596.     {'$gen_switch_on_term'(FA, All, SWTPred, LV, LI, LC, LS, LL, SWT, [])}.
  597.  
  598. '$gen_switch_on_term'(FA, All, [], L, L, L, L, L) --> !,
  599.     '$generate_noswitch'(FA, All).
  600. '$gen_switch_on_term'(FA, All, [LV,LI,LC,LS,LL], LV, LI, LC, LS, LL) -->
  601.     [exec_method(FA, [], top, [switch_on_term(LV,LI,LC,LS,LL)])],
  602.     [LV : []],
  603.      '$generate_tries'(All, LV).
  604.  
  605. '$generate_noswitch'(FA, All) --> !,
  606.     {All = [N|Ns]},
  607.     [put_static_pred(FA+sub/1)],
  608.     [exec_method(FA, [], top, [try(FA+N, FA+sub/1)])],
  609.     [FA+sub/1 : []],
  610.     '$generate_tries2'(Ns, FA, sub, 2).
  611.  
  612. '$generate_sw'(Clauses, Type, FA, All, L) -->
  613.     {'$select_type'(Clauses, Type, 1, Ns)},
  614.     {Ns = All},
  615.     !,
  616.     {L = FA+var}.
  617. '$generate_sw'(Clauses, Type, FA, _, L) -->
  618.     {'$select_type'(Clauses, Type, 1, Ns)},
  619.     '$generate_sw1'(Ns, Type, FA, L).
  620.  
  621. '$generate_sw1'([], _, _, '$fail') --> !.
  622. '$generate_sw1'([N], _, FA, FA+N) --> !.
  623. '$generate_sw1'(Ns, Type, FA, L) -->
  624.     {L = FA+Type},
  625.     [L: []],
  626.     '$generate_tries'(Ns, L).
  627.  
  628. '$generate_tries'(Ns, FA+Type) -->
  629.     '$generate_tries'(Ns, FA, Type, 1).
  630.  
  631. '$generate_tries'([N|Ns], FA, T, I) -->
  632.     [put_static_pred(FA+T/I)],
  633.     [exec_method(FA, [], try, [try(FA+N, FA+T/I)])],
  634.     [FA+T/I : []],
  635.     {J is I + 1},
  636.     '$generate_tries2'(Ns, FA, T, J).
  637.  
  638. '$generate_tries2'([N], FA, _, _) --> !,
  639.     [exec_method(FA, [], trust, [trust(FA+N)])].
  640. '$generate_tries2'([N|Ns], FA, T, I) --> !,
  641.     [put_static_pred(FA+T/I)],
  642.     [exec_method(FA, [], retry, [retry(FA+N, FA+T/I)])],
  643.     [FA+T/I : []],
  644.     {J is I + 1},
  645.     '$generate_tries2'(Ns, FA, T, J).
  646.  
  647. '$select_type'([], _, _, []) :- !.
  648. '$select_type'([Clause|Clauses], Type, N, [N|Ns]) :-
  649.     '$match_type'(Clause, Type),
  650.     !,
  651.     N1 is N + 1,
  652.     '$select_type'(Clauses, Type, N1, Ns).
  653. '$select_type'([_|Clauses], Type, N, Ns) :-
  654.     N1 is N + 1,
  655.     '$select_type'(Clauses, Type, N1, Ns).
  656.  
  657. '$match_type'(_, var) :- !.
  658. '$match_type'((Head :- _), Type) :-
  659.     arg(1, Head, A1),
  660.     '$match_type1'(A1, Type).
  661.  
  662. '$match_type1'(A1, _) :- var(A1), !.
  663. '$match_type1'(A1, Type) :- integer(A1), !, Type=int.
  664. '$match_type1'(A1, Type) :- atom(A1), !, Type=con.
  665. '$match_type1'([_|_], Type) :- !, Type=lis.
  666. '$match_type1'(A1, Type) :- functor(A1, _, _), !, Type=str.
  667.  
  668. /*===============================================================
  669.     $B@a$N%3%s%Q%$%k(B
  670. ===============================================================*/
  671. '$compile_clause'((_Head :- Body), [], []) -->
  672.     {nonvar(Body)}, {Body = '$CS'(CsCode)}, !,
  673.     [cs_code(CsCode)].
  674. '$compile_clause'((Head0 :- Body0), StaticCode, VarInfo) -->
  675.         {'$transform'((Head0 :- Body0), (Head :- Body))},    % Binary$B@a$KJQ49(B
  676.     {'$precompile'(Head, Body, Code)},   %$BAH9~$_=R8l$J$I$N%W%l%3%s%Q%$%k(B
  677.          '$compile_chunks'(Code, TermInfo),  %put,get$B$N%3%s%Q%$%k(B
  678.     {'$compile_ground'(TermInfo, VarInfo, StaticCode, [])},
  679.     !.
  680. '$compile_clause'(Clause, _, _) -->
  681.     {'$message'([compilation,of,Clause,failed])},
  682.     {fail}.
  683.  
  684. /*-------------------------------------------------------------------
  685.     Prolog$B@a$+$i(BBinary$B@a$X$NJQ49%k!<%A%s(B
  686.  
  687.  For example, the well-known append/3 program:
  688.      append([], Y, Y).
  689.      append([X|Xs], Y, [X|Z]) :- append(Xs, Y, Z).
  690.  is transformed to
  691.      append([], Y, Y, Cont) :- true(Cont).
  692.      append([X|Xs], Y, [X|Z], Cont) :- append(Xs, Y, Z, Cont).
  693.  Binarization technique was developed by P.Tarau and M.Boyer,
  694.  please see:
  695.      * "Elementary Logic Programs"
  696.         P.Tarau and M.Boyer
  697.         Programming Language Implementation and Logic Programming,
  698.     p.159--173, LNCS 456, Springer Verlag, 1990
  699.      * "BinProlog 5.40 User Guide"
  700.         P.Tarau
  701.         Available from http://clement.info.umoncton.ca/BinProlog/
  702. -------------------------------------------------------------------*/
  703. '$transform'(Cl, BinCl) :- !, '$transform'(Cl, cont, BinCl).
  704.  
  705. '$transform'((H :- B0), Cont, (H :- B)) :- !,
  706.     '$transform_body'(B0, Cont, B).
  707. '$transform'(H, Cont, (H :- true(Cont))).
  708.  
  709. '$transform_body'(B0, Cont, B) :-
  710.     '$trans_body'(B0, Cut, B1, []),
  711.     '$transform_body1'(Cut, B1, B2),
  712.     '$binarize_body'(B2, Cont, B).
  713.  
  714. '$transform_body1'(Cut, B, B) :- var(Cut), !.
  715. '$transform_body1'('$cut'(Level), ['$cut'(Level)|Bs], ['$neck_cut'|Bs]) :- !.
  716. '$transform_body1'('$cut'(Level), Bs, ['$get_level'(Level)|Bs]).
  717.  
  718. '$trans_body'(G, Cut) --> {var(G)}, !,
  719.     '$trans_body'(call(G), Cut).
  720. '$trans_body'(!, Cut) --> !,
  721.     {Cut = '$cut'(Level)},
  722.     ['$cut'(Level)].
  723. '$trans_body'(otherwise, _) --> !.
  724. '$trans_body'(true, _)  --> !.
  725. '$trans_body'(fail, _)  --> !, ['$fail'].
  726. '$trans_body'(false, _) --> !, ['$fail'].
  727. '$trans_body'(halt, _)  --> !, ['$abort'].
  728. '$trans_body'(abort, _) --> !, ['$abort'].
  729. '$trans_body'(top, _)   --> !, ['$top'].
  730. '$trans_body'(erase, _) --> !, ['$top'].
  731. '$trans_body'((G1,G2), Cut) --> !,
  732.     '$trans_body'(G1, Cut),
  733.     '$trans_body'(G2, Cut).
  734. % for LLP
  735. '$trans_body'((G1&G2), Cut) --> !,
  736.     ['$begin_with'],
  737.      '$trans_body'(G1, Cut),
  738.     ['$mid_with'],
  739.      '$trans_body'(G2, Cut),
  740.     ['$end_with'].
  741. '$trans_body'((!R-<>G), Cut) --> !,
  742.     '$trans_body'((R=>G), Cut).
  743. '$trans_body'((R-<>G), Cut) --> !,
  744.     ['$begin_imp'(L1)],
  745.      '$precompile_resource'(G, R, G1),
  746.     ['$mid_imp'(L2)],
  747.      '$trans_body'(G1, Cut),
  748.     ['$end_imp'(L1, L2)].
  749. '$trans_body'((R=>G), Cut) --> !,
  750.     ['$begin_imp'(L1)],
  751.      '$precompile_exp_resource'(G, R, G1),
  752.     ['$mid_exp_imp'(L2)],
  753.      '$trans_body'(G1, Cut),
  754.     ['$end_exp_imp'(L1, L2)].
  755. '$trans_body'(!G, Cut) --> !,
  756.     ['$begin_bang'],
  757.      '$trans_body'(G, Cut),
  758.     ['$end_bang'].
  759. '$trans_body'(G, _) -->
  760.     '$precompile_builtin'(G), !.
  761. '$trans_body'(G, _) -->
  762.     [G].
  763.  
  764. '$binarize_body'([], Cont, true(Cont)) :- !.
  765. '$binarize_body'([G], Cont, Body) :- !,
  766.     '$add_cont'(G, Cont, Body).
  767. '$binarize_body'([G|Gs], Cont, Body) :-
  768.     '$binarize_body'(Gs, Cont, Body0),
  769.     '$add_cont'(G, Body0, Body).
  770.  
  771. '$add_cont'(G, Cont, Binbody) :-
  772.     G =.. [F|A0],
  773.     '$append'(A0, [Cont], A),
  774.     Binbody =.. [F|A].
  775.  
  776. /*---------------------------------------------------------------
  777.     $B%j%=!<%9$N%W%l%3%s%Q%$%k(B
  778. ---------------------------------------------------------------*/
  779. /* Linear$B%j%=!<%9(B */
  780. '$precompile_resource'(G, R, G) --> {var(G)}, !,
  781.     '$precomp_resource'(R).
  782. '$precompile_resource'((R1-<>G1), R0, G) --> !,
  783.     '$precompile_resource'(G1, (R0,R1), G).
  784. '$precompile_resource'(G, R, G) -->
  785.     '$precomp_resource'(R).
  786.  
  787. '$precomp_resource'(R) -->
  788.     {'$decomp_resource'(R, R1)},
  789.      '$precomp_res'(R1).
  790.    
  791. '$precomp_res'((R1,R2)) --> !,
  792.     '$precomp_res'(R1),
  793.     ['$more_imp'],
  794.     '$precomp_res'(R2).
  795. '$precomp_res'((R1&R2)) --> !,
  796.     '$precomp_res'(R1),
  797.     '$precomp_res'(R2).
  798. '$precomp_res'(resource(H, B, Vs)) -->
  799.     {'$inc_res_counter'(N)},
  800.     {functor(H,F,A), I = '$res'(F/A,N)},
  801.     {copy_term([H,B,Vs,I], [H1,B1,Vs1,I1])},
  802.     {'$compile_resource'(H1,B1, Vs1, I1)},
  803.     ['$add_res'(H, '$closure'(I, Vs))].
  804.  
  805. /* Exponential$B%j%=!<%9(B */
  806. '$precompile_exp_resource'(G, R, G) --> {var(G)}, !,
  807.     '$precomp_exp_resource'(R).
  808. '$precompile_exp_resource'((R1=>G1), R0, G) --> !,
  809.     '$precompile_exp_resource'(G1, (R0,R1), G).
  810. '$precompile_exp_resource'((!R1-<>G1), R0, G) --> !,
  811.     '$precompile_exp_resource'(G1, (R0,R1), G).
  812. '$precompile_exp_resource'(G, R, G) -->
  813.     '$precomp_exp_resource'(R).
  814.  
  815. '$precomp_exp_resource'(R) -->
  816.     {'$decomp_resource'(R, R1)},
  817.      '$precomp_exp_res'(R1).
  818.    
  819. '$precomp_exp_res'((R1,R2)) --> !,
  820.     '$precomp_exp_res'(R1),
  821.     '$precomp_exp_res'(R2).
  822. '$precomp_exp_res'((R1&R2)) --> !,
  823.     '$precomp_exp_res'(R1),
  824.     '$precomp_exp_res'(R2).
  825. '$precomp_exp_res'(resource(H, B, Vs)) -->
  826.     {'$inc_res_counter'(N)},
  827.     {functor(H,F,A), I = '$res'(F/A,N)},
  828.     {copy_term([H,B,Vs,I], [H1,B1,Vs1,I1])},
  829.     {'$compile_resource'(H1,B1, Vs1, I1)},
  830.     ['$add_exp_res'(H, '$closure'(I, Vs))].
  831.  
  832. '$inc_res_counter'(N) :-
  833.     retract('$res_counter'(N)),
  834.     N1 is N+1,
  835.     assert('$res_counter'(N1)).
  836.    
  837. /* $B%j%=!<%9$r%W%j%_%F%#%V%j%=!<%9$KJ,2r(B */
  838. '$decomp_resource'(R, R1) :- '$decomp_R'(R, R1).
  839.  
  840. '$decomp_R'(R, _) :- var(R), !,
  841.     '$message'([resource,R,should,not,be,a,variable]),
  842.     fail.
  843. '$decomp_R'((R1,R2), (RR1,RR2)) :- !,
  844.     '$decomp_R'(R1, RR1),
  845.     '$decomp_R'(R2, RR2).
  846. '$decomp_R'(R, RR) :-
  847.     '$decomp_S'(R, RR).
  848.  
  849. '$decomp_S'(R, _) :- var(R), !,
  850.     '$message'([resource,R,should,not,be,a,variable]),
  851.     fail.
  852. '$decomp_S'((R1&R2), (RR1&RR2)) :- !,
  853.     '$decomp_S'(R1, RR1),
  854.     '$decomp_S'(R2, RR2).
  855. '$decomp_S'((forall Xs\R1&R2), RR) :- !,
  856.     '$decomp_S'(((forall Xs\R1)&(forall Xs\R2)), RR).
  857. '$decomp_S'((B -<> (forall Xs\R)), RR) :- !,
  858.     '$decomp_S'((forall Xs\ B-<>R), RR).
  859. '$decomp_S'((B  => (forall Xs\R)), RR) :- !,
  860.     '$decomp_S'((forall Xs\ !B-<>R), RR).
  861. '$decomp_S'((B1 -<> B2 -<> H), RR) :- !,
  862.     '$decomp_S'(((B1,B2) -<> H), RR).
  863. '$decomp_S'((B1 => B2 -<> H), RR) :- !,
  864.     '$decomp_S'(((!B1,B2) -<> H), RR).
  865. '$decomp_S'((B1 -<> B2 => H), RR) :- !,
  866.     '$decomp_S'(((B1,!B2) -<> H), RR).
  867. '$decomp_S'((B1 => B2 => H), RR) :- !,
  868.     '$decomp_S'(((!B1,!B2) -<> H), RR).
  869. '$decomp_S'((B -<> (H1&H2)), RR) :- !,
  870.     '$decomp_S'(((B -<> H1)&(B -<> H2)), RR).
  871. '$decomp_S'((B => (H1&H2)), RR) :- !,
  872.     '$decomp_S'(((!B -<> H1)&(!B -<> H2)), RR).
  873. '$decomp_S'((forall Xs\B -<> H), RR) :- '$resource_head'(H), !,
  874.     '$free_variables'([B,H], Vs),
  875.     '$forall_vars'(Xs, FVs, []),
  876.     '$delete_forall_vars'(Vs, FVs, Vs1),
  877.     RR = resource(H, B, Vs1).
  878. '$decomp_S'((B -<> H), RR) :- '$resource_head'(H), !,
  879.     '$free_variables'([B,H], Vs),
  880.     RR = resource(H, B, Vs).
  881. '$decomp_S'((forall Xs\B => H), RR) :- '$resource_head'(H), !,
  882.     '$free_variables'([B,H], Vs),
  883.     '$forall_vars'(Xs, FVs, []),
  884.     '$delete_forall_vars'(Vs, FVs, Vs1),
  885.     RR = resource(H, !B, Vs1).
  886. '$decomp_S'((B => H), RR) :- '$resource_head'(H), !,
  887.     '$free_variables'([B,H], Vs),
  888.     RR = resource(H, !B, Vs).
  889. '$decomp_S'((forall Xs\H), RR) :- '$resource_head'(H), !,
  890.     '$free_variables'(H, Vs),
  891.     '$forall_vars'(Xs, FVs, []),
  892.     '$delete_forall_vars'(Vs, FVs, Vs1),
  893.     RR = resource(H, true, Vs1).
  894. '$decomp_S'(H, RR) :- '$resource_head'(H), !,
  895.     '$free_variables'(H, Vs),
  896.     RR = resource(H, true, Vs).
  897. '$decomp_S'(R, _) :-
  898.     '$message'([resource,R,is,invalid]),
  899.     fail.
  900.  
  901. '$resource_head'(H) :-
  902.     \+ (H = !(_)),
  903.     \+ (H = (_ , _)),
  904.     \+ (H = (_ & _)),
  905.     \+ (H = (_ -<> _)),
  906.     \+ (H = (forall _)).
  907.  
  908. '$free_variables'(X, Vs) :-
  909.     '$variables'(X, Vs).
  910.  
  911. '$forall_vars'(X) --> {nonvar(X), X = (X1,X2)},!,
  912.     {var(X1)}, [X1], '$forall_vars'(X2).
  913. '$forall_vars'(X) --> {var(X)}, [X], !.
  914. '$forall_vars'(X) --> !,
  915.     {'$message'([free,variable,X,is,invalid]), fail}.
  916.  
  917. '$delete_forall_vars'([X|Xs], FV, Ys) :-  '$memq'(X, FV), !,
  918.     '$delete_forall_vars'(Xs, FV, Ys).
  919. '$delete_forall_vars'([X|Xs], FV, [X|Ys]) :- !,
  920.     '$delete_forall_vars'(Xs, FV, Ys).
  921. '$delete_forall_vars'([], _, []).
  922.  
  923. %'$precomp_put'(X, X) --> {var(X)}, !.
  924. %'$precomp_put'(X, U) -->
  925. %   [put(X, U)].
  926.  
  927. /*---------------------------------------------------------------
  928.     Head$B$H(BBody$B$N%W%l%3%s%Q%$%k(B
  929. ---------------------------------------------------------------*/
  930. '$precompile'(Head, Body0, Instrs) :-
  931.     '$precompile_head'(Head, Instrs0, Bs),
  932.     '$first_call_opt'(Head, Body0, Body),
  933.     '$precompile_body'(Body, Bs, []),
  934.     '$flatten_code'(Instrs0, Instrs, []).
  935.  
  936. '$precompile_head'(Head) -->
  937.     {Head =.. [_|Args]},
  938.     '$precomp_head'(Args, 1).
  939.  
  940. '$precomp_head'([], _) --> !.
  941. '$precomp_head'([A|As], I) -->
  942.     [get(A, a(I))],
  943.     {I1 is I + 1},
  944.     '$precomp_head'(As, I1).
  945.  
  946. '$first_call_opt'(true, Body, Body) :- !.
  947. '$first_call_opt'(Head, Body, NewBody) :-
  948.     Head =..[F1|As1],
  949.     Body =..[F2|As2],
  950.     length(As1, L1),
  951.     length(As2, L2),
  952.     F1 == F2, L1 =:= L2-1,
  953.     !,
  954.     assert('$fco_predicates'(F1, L1)),
  955.     NewBody =.. ['$FCO'|As2].
  956. '$first_call_opt'(_, Body, Body).
  957.  
  958. '$precompile_body'(true(cont)) -->!,
  959.     [execute(cont)].
  960. '$precompile_body'(G) -->
  961.     {G =.. [F|Args]},
  962.     '$precomp_call'(F, Args, Vs),
  963.     {P =.. [F|Vs]},
  964.     [execute(P)].
  965.  
  966. '$precomp_call'(_, [G], [V]) --> !,
  967.     '$precomp_cont'(G, V).
  968. '$precomp_call'(F, [A|As], [V|Vs]) -->
  969.     '$precomp_put'(F, A, V),
  970.     %[put(A, V)],
  971.     '$precomp_call'(F, As, Vs).
  972.  
  973. '$precomp_cont'(cont, V) --> !, {cont = V}.
  974. '$precomp_cont'(G, V) -->
  975.     {G =.. [F|Args]},
  976.     '$precomp_call'(F, Args, Vs),
  977.     {P =.. [F|Vs]},
  978.     [put_cont(P, V)].
  979.  
  980. '$precomp_put'(F, X, V) -->
  981.     {(F == '$add_res'; F == '$add_exp_res')},
  982.     {nonvar(X)},
  983.     {X = '$closure'(Res, Vs)},
  984.      !,
  985.     [put_free_vars(Vs, W)],
  986.     [put_closure(Res, W, V)].
  987. '$precomp_put'(_, X, V) --> [put(X, V)].
  988.  
  989. %'$precomp_cont'(cont, V) --> !, {cont = V}.
  990. %'$precomp_cont'(G, V) -->
  991. %   {G =.. [F|Args]},
  992. %   '$precomp_call'(F, Args, Vs),
  993. %   {P =.. [F|Vs]},
  994. %   [put_cont(P, V)].
  995.  
  996. /*---------------------------------------------------------------
  997.     $BAH$_9~$_=R8l$N%W%l%3%s%Q%$%k(B
  998. ---------------------------------------------------------------*/
  999. '$precompile_builtin'(X == Y)   --> !, ['$equality_of_term'(X, Y)].
  1000. '$precompile_builtin'(X \== Y)  --> !, ['$inequality_of_term'(X, Y)].
  1001. '$precompile_builtin'(X = Y)    --> !, ['$unify'(X, Y)].
  1002. '$precompile_builtin'(?=(X, Y)) --> !, ['$identical_or_cannot_unify'(X, Y)].
  1003. '$precompile_builtin'(X @< Y)   --> !, ['$before'(X, Y)].
  1004. '$precompile_builtin'(X @> Y)   --> !, ['$after'(X, Y)].
  1005. '$precompile_builtin'(X @=< Y)  --> !, ['$not_after'(X, Y)].
  1006. '$precompile_builtin'(X @>= Y)  --> !, ['$not_before'(X, Y)].
  1007. '$precompile_builtin'(compare(X,Y,Z))  --> !, ['$compare'(X,Y,Z)].
  1008. '$precompile_builtin'(functor(X,Y,Z))  --> !, ['$functor'(X,Y,Z)].
  1009. '$precompile_builtin'(arg(X,Y,Z))      --> !, ['$arg'(X,Y,Z)].
  1010.  
  1011. '$precompile_builtin'(var(X))          --> !, ['$var'(X)].
  1012. '$precompile_builtin'(nonvar(X))       --> !, ['$nonvar'(X)].
  1013. '$precompile_builtin'(atom(X))         --> !, ['$atom'(X)].
  1014. '$precompile_builtin'(integer(X))      --> !, ['$integer'(X)].
  1015. '$precompile_builtin'(atomic(X))       --> !, ['$atomic'(X)].
  1016. '$precompile_builtin'(copy_term(X,Y))  --> !, ['$copy_term'(X,Y)].
  1017.  
  1018. % JJC changed java_ to cs_ and added load_assembly_1
  1019.  
  1020. '$precompile_builtin'(load_assembly(X)) --> !, ['$load_assembly'(X)].
  1021. '$precompile_builtin'(cs_object(X))  --> !, ['$cs_object'(X)].
  1022. '$precompile_builtin'(cs_constructor(X,Y))  --> !, ['$cs_constructor'(X,Y)].
  1023. '$precompile_builtin'(cs_method(X,Y,Z))     --> !, ['$cs_method'(X,Y,Z)].
  1024. '$precompile_builtin'(cs_get_field(X,Y,Z))  --> !, ['$cs_get_field'(X,Y,Z)].
  1025. '$precompile_builtin'(cs_set_field(X,Y,Z))  --> !, ['$cs_set_field'(X,Y,Z)].
  1026. '$precompile_builtin'(cs_term(X,Y))  --> !, ['$cs_term'(X,Y)].
  1027. '$precompile_builtin'(url_source(X,Y))  --> !, ['$url_source'(X,Y)].
  1028.  
  1029. %$B$3$l$I$&$9$k!)(B
  1030. '$precompile_builtin'(call(X))  --> !, ['$call'(X)].
  1031.  
  1032. '$precompile_builtin'(open_table(X))    --> !, ['$open_table'(X)].
  1033. '$precompile_builtin'(clear_table(X))   --> !, ['$clear_table'(X)].
  1034. '$precompile_builtin'(close_table(X))   --> !, ['$close_table'(X)].
  1035. '$precompile_builtin'(set_table(X))     --> !, ['$set_table'(X)].
  1036. '$precompile_builtin'(current_table(X)) --> !, ['$current_table'(X)].
  1037.  
  1038. '$precompile_builtin'(current_input(X))  --> !, ['$current_input'(X)].
  1039. '$precompile_builtin'(current_output(X)) --> !, ['$current_output'(X)].
  1040. '$precompile_builtin'(set_input(X))      --> !, ['$set_input'(X)].
  1041. '$precompile_builtin'(set_output(X))     --> !, ['$set_output'(X)].
  1042. '$precompile_builtin'(close(X))          --> !, ['$close'(X)].
  1043. '$precompile_builtin'(flush_output(X))   --> !, ['$flush_output'(X)].
  1044. '$precompile_builtin'(flush_output)      --> !, ['$flush_output'].
  1045.  
  1046. '$precompile_builtin'(get0(X))   --> !, ['$get0'(X)].
  1047. '$precompile_builtin'(get0(S,X)) --> !, ['$get0'(S,X)].
  1048. '$precompile_builtin'(get(X))    --> !, ['$get'(X)].
  1049. '$precompile_builtin'(get(S,X))  --> !, ['$get'(S,X)].
  1050. '$precompile_builtin'(put(X))    --> !, ['$put'(X)].
  1051. '$precompile_builtin'(put(S,X))  --> !, ['$put'(S,X)].
  1052. '$precompile_builtin'(tab(X))    --> !, ['$tab'(X)].
  1053. '$precompile_builtin'(tab(S,X))  --> !, ['$tab'(S,X)].
  1054. '$precompile_builtin'(nl)        --> !, ['$nl'].
  1055. '$precompile_builtin'(nl(S))     --> !, ['$nl'(S)].
  1056.  
  1057. %'$precompile_builtin'(X =.. Y)  --> !, ['$univ'(X, Y)].
  1058.  
  1059. '$precompile_builtin'(X =:= Y) --> !,
  1060.     '$precompile_is'(U, X),
  1061.     '$precompile_is'(V, Y),
  1062.     ['$arith_equal'(U, V)].
  1063. '$precompile_builtin'(X =\= Y) --> !,
  1064.     '$precompile_is'(U, X),
  1065.     '$precompile_is'(V, Y),
  1066.     ['$arith_not_equal'(U, V)].
  1067. '$precompile_builtin'(X > Y)   --> !,
  1068.     '$precompile_is'(U, X),
  1069.     '$precompile_is'(V, Y),
  1070.     ['$greater_than'(U, V)].
  1071. '$precompile_builtin'(X >= Y)  --> !,
  1072.     '$precompile_is'(U, X),
  1073.     '$precompile_is'(V, Y),
  1074.     ['$greater_or_equal'(U, V)].
  1075. '$precompile_builtin'(X < Y)   --> !,
  1076.     '$precompile_is'(U, X),
  1077.     '$precompile_is'(V, Y),
  1078.     ['$less_than'(U, V)].
  1079. '$precompile_builtin'(X =< Y)  --> !,
  1080.     '$precompile_is'(U, X),
  1081.     '$precompile_is'(V, Y),
  1082.     ['$less_or_equal'(U, V)].
  1083. '$precompile_builtin'(X is Y)  --> !,
  1084.     '$generate_is'(Y, X).
  1085.  
  1086. /* $B;;=Q1i;;$N%W%l%3%s%Q%$%k(B */
  1087. '$precompile_is'(X, X) --> {var(X)}, !.
  1088. '$precompile_is'(X, Y) --> '$generate_is'(Y, X).
  1089.  
  1090. '$generate_is'(X, A) --> {var(X)}, !, ['$is'(A, X)].
  1091. '$generate_is'(X, _) --> {float(X)}, !,
  1092.     {'$message'([floating,point,numbers,are,not,supported])},
  1093.     {fail}.
  1094. '$generate_is'(X, A) --> {integer(X)}, !, {X = A}.
  1095. '$generate_is'([X], A)  --> !, '$gen_is'(X, A).
  1096. '$generate_is'(+(X), A) --> !, '$gen_is'(X, A).
  1097. '$generate_is'(-(X), A) --> !, '$generate_is'(-1*X, A).
  1098. '$generate_is'(\(X), A) --> !,
  1099.     '$gen_is'(X, U),
  1100.     ['$bitwise_neg'(U, A)].
  1101. '$generate_is'(X+Y, A) --> !,
  1102.     '$gen_is'(X, U),
  1103.     '$gen_is'(Y, V),
  1104.     ['$plus'(U, V, A)].
  1105. '$generate_is'(X-Y, A) --> !,
  1106.     '$gen_is'(X, U),
  1107.     '$gen_is'(Y, V),
  1108.     ['$minus'(U, V, A)].
  1109. '$generate_is'(X*Y, A) --> !,
  1110.     '$gen_is'(X, U),
  1111.     '$gen_is'(Y, V),
  1112.     ['$multi'(U, V, A)].
  1113. '$generate_is'(X/Y, A) --> !,
  1114.     '$gen_is'(X, U),
  1115.     '$gen_is'(Y, V),
  1116.     ['$float_quotient'(U, V, A)].
  1117. '$generate_is'(X//Y, A) --> !,
  1118.     '$gen_is'(X, U),
  1119.     '$gen_is'(Y, V),
  1120.     ['$int_quotient'(U, V, A)].
  1121. '$generate_is'(X mod Y, A) --> !,
  1122.     '$gen_is'(X, U),
  1123.     '$gen_is'(Y, V),
  1124.     ['$remainder'(U, V, A)].
  1125. '$generate_is'(X<<Y, A) --> !,
  1126.     '$gen_is'(X, U),
  1127.     '$gen_is'(Y, V),
  1128.     ['$leftshift'(U, V, A)].
  1129. '$generate_is'(X>>Y, A) --> !,
  1130.     '$gen_is'(X, U),
  1131.     '$gen_is'(Y, V),
  1132.     ['$rightshift'(U, V, A)].
  1133. '$generate_is'(X/\Y, A) --> !,
  1134.     '$gen_is'(X, U),
  1135.     '$gen_is'(Y, V),
  1136.     ['$bitwise_conj'(U, V, A)].
  1137. '$generate_is'(X\/Y, A) --> !,
  1138.     '$gen_is'(X, U),
  1139.     '$gen_is'(Y, V),
  1140.     ['$bitwise_disj'(U, V, A)].
  1141. '$generate_is'(X#Y,  A) --> !,
  1142.     '$gen_is'(X, U),
  1143.     '$gen_is'(Y, V),
  1144.     ['$bitwise_exclusive_or'(U, V, A)].
  1145. '$generate_is'(integer(X), A) --> !,
  1146.     '$gen_is'(X, U),
  1147.     ['$to_integer'(U, A)].
  1148. %'$generate_is'(float(X), A) --> !, '$gen_is'(X, U),
  1149. %   ['$to_float'(U, A)].
  1150. '$generate_is'(abs(X), A) --> !,
  1151.     '$gen_is'(X, U),
  1152.     ['$abs'(U, A)].
  1153. '$generate_is'(max(X,Y), A) --> !,
  1154.     '$gen_is'(X, U),
  1155.     '$gen_is'(Y, V),
  1156.     ['$max'(U, V, A)].
  1157. '$generate_is'(min(X,Y), A) --> !,
  1158.     '$gen_is'(X, U),
  1159.     '$gen_is'(Y, V),
  1160.     ['$min'(U, V, A)].
  1161. '$generate_is'(X, _) -->
  1162.     {'$message'([unknown,arithemetic,expression,X])},
  1163.     {fail}.
  1164.  
  1165. '$gen_is'(X, A) --> {var(X)}, {var(A)}, !, {X = A}.
  1166. '$gen_is'(X, A) --> '$generate_is'(X, A).
  1167.  
  1168. /*---------------------------------------------------------------
  1169.     $B%3%s%Q%$%k(B
  1170. ---------------------------------------------------------------*/
  1171. '$compile_chunks'(Chunk, TermInfo) -->
  1172.     {'$alloc_voids'(Chunk, [], Alloc)}, /* void$BJQ?t$N%A%'%C%/(B */
  1173.         '$compile_chunk'(Chunk, Alloc, TermInfo).
  1174.  
  1175. '$compile_chunk'([], _, []) --> !.
  1176. '$compile_chunk'(Chunk, Alloc, TermInfo) -->
  1177.     {'$free_x_reg'(Chunk, 1, XN), SN = 1, PN = 1},
  1178.     {TermInfo0 = [XN, SN, PN, Alloc]},
  1179.     '$comp_chunk'(Chunk, TermInfo0, TermInfo).
  1180.  
  1181. '$comp_chunk'([], TI, TI) --> !.
  1182. '$comp_chunk'([(L:[])|Cs], TI0, TI) --> !,
  1183.     [L:[]],
  1184.     '$comp_chunk'(Cs, TI0, TI).
  1185. '$comp_chunk'([(L:C)|Cs], TI0, TI) --> !,
  1186.     [L:[]],
  1187.     '$comp_chunk'([C|Cs], TI0, TI).
  1188. '$comp_chunk'([C|Cs], TI0, TI) --> !,
  1189.     '$comp_instr'(C, TI0, TI1), /* get, put$BL?Na$N@8@.(B */
  1190.     '$comp_chunk'(Cs, TI1, TI).
  1191.  
  1192. /* $B;HMQ2DG=$J(Ba_register$B$N@hF,HV9f$rC5$9(B */
  1193. '$free_x_reg'([], XN, XN).
  1194. '$free_x_reg'([get(_,V)|Cs], XN0, XN) :- nonvar(V), V = a(N), !,
  1195.     '$mymax'(N+1, XN0, XN1),
  1196.     '$free_x_reg'(Cs, XN1, XN).
  1197. '$free_x_reg'([put(_,V)|Cs], XN0, XN) :- nonvar(V), V = a(N), !,
  1198.     '$mymax'(N+1, XN0, XN1),
  1199.     '$free_x_reg'(Cs, XN1, XN).
  1200. '$free_x_reg'([_|Cs], XN0, XN) :-
  1201.     '$free_x_reg'(Cs, XN0, XN).
  1202.  
  1203. /* void$BJQ?t$N%A%'%C%/(B */
  1204. '$alloc_voids'(Chunks, Alloc0, Alloc) :-
  1205.     '$variables'(Chunks, Vars),
  1206.     '$alloc_voids1'(Vars, Chunks, Alloc0, Alloc).
  1207.  
  1208. '$alloc_voids1'([], _, Alloc, Alloc).
  1209. '$alloc_voids1'([V|Vars], Chunks, Alloc0, Alloc) :-
  1210.     '$count_variable'(V, Chunks, 1),
  1211.     !,
  1212.     Alloc1 = [[V,void,_Seen]|Alloc0],
  1213.     '$alloc_voids1'(Vars, Chunks, Alloc1, Alloc).
  1214. '$alloc_voids1'([_|Vars], Chunks, Alloc0, Alloc) :-
  1215.     '$alloc_voids1'(Vars, Chunks, Alloc0, Alloc).
  1216.  
  1217. %alloc_var([], _, Alloc, Alloc).
  1218. '$alloc_voids1'([V|Vars], Chunks, Alloc0, Alloc) :-
  1219.     '$count_variable'(V, Chunks, 1),
  1220.     !,
  1221.     Alloc1 = [[V,void,_Seen]|Alloc0],
  1222.     '$alloc_voids1'(Vars, Chunks, Alloc1, Alloc).
  1223. '$alloc_voids1'([_|Vars], Chunks, Alloc0, Alloc) :-
  1224.     '$alloc_voids1'(Vars, Chunks, Alloc0, Alloc).
  1225.  
  1226. /*---------------------------------------------------------------
  1227.     get, put$BEy$N%3%s%Q%$%k(B
  1228. ---------------------------------------------------------------*/
  1229. /*
  1230.   comp_instr(+Instr, +TermInfo0, -TermInfo)
  1231.   Instr    : Intermediate instruction
  1232.   TermInfo : [X, Y, Z, Alloc]
  1233.   X        : a(X),a(X+1),... are available (for term)
  1234.   Y        : s(Y),s(Y+1),... are available (for ground term)
  1235.   Z        : p(Z),p(Z+1),... are available (for cont. predicate)
  1236.   Alloc    : [[Term,Type,Seen],...]
  1237. */
  1238. '$comp_instr'(get(X, A), TermInfo0, TermInfo) --> !,
  1239.     '$gen_get'(X, A, TermInfo0, TermInfo).
  1240. '$comp_instr'(put(X, V), TermInfo0, TermInfo) --> !,
  1241.     '$gen_put'(X, V, TermInfo0, TermInfo).
  1242. '$comp_instr'(put_cont(X, V), TermInfo0, TermInfo) --> !,
  1243.     '$gen_put_cont'(X, V, TermInfo0, TermInfo).
  1244.  
  1245. '$comp_instr'(put_free_vars(X, V), TermInfo0, TermInfo) --> !,
  1246.     '$gen_put_free_vars'(X, V, TermInfo0, TermInfo).
  1247.  
  1248. '$comp_instr'(put_closure(X,Y,V), TermInfo0, TermInfo) --> !,
  1249.     '$gen_put_closure'(X, Y, V, TermInfo0, TermInfo).
  1250.  
  1251. '$comp_instr'(Instr, TermInfo, TermInfo) --> [Instr].
  1252.  
  1253. /*---------------------------------------------------------------
  1254.     get, unify$BL?Na$N@8@.(B
  1255. ---------------------------------------------------------------*/
  1256. '$gen_get'(X, A, TI0, TI) -->
  1257.     '$gen_get'([A=X], TI0, TI).
  1258.  
  1259. '$gen_get'([], TI, TI) --> !.
  1260. '$gen_get'([A=X|_], TI, TI) --> {var(A)}, !,
  1261.     {'$message'([get(X,A),error]), fail}.
  1262. '$gen_get'([A=X|Instrs], TI0, TI) --> {var(X)},
  1263.     {'$assign_reg'(X, R, Seen, TI0, TI1)},
  1264.     {nonvar(Seen)}, !,
  1265.     '$gen_get_var'(R, Seen, A),
  1266.     '$gen_get'(Instrs, TI1, TI).
  1267. /* $B$3$l$G$$$$$G$N$+$J!)(B */
  1268. '$gen_get'([A=X|Instrs], TI0, TI) --> {var(X)}, !,
  1269.     {TI0 = [XN,SN,PN,Alloc0]},
  1270.     {TI1 = [XN,SN,PN,[[X,A,Seen]|Alloc0]]},
  1271.     {Seen = yes},
  1272.     '$gen_get'(Instrs, TI1, TI).
  1273.  
  1274. '$gen_get'([_=X|_], _, _) --> {float(X)}, !,
  1275.     {'$message'([floating,point,numbers,are,not,supported])}, {fail}.
  1276. '$gen_get'([A=X|Instrs], TI0, TI) --> {integer(X)}, !,
  1277.     {'$assign_reg'(X, R, Seen, TI0, TI1)},
  1278.     {Seen = yes},
  1279.     [get_int(R, A)],
  1280.     '$gen_get'(Instrs, TI1, TI).
  1281. '$gen_get'([A=X|Instrs], TI0, TI) --> {atom(X)}, !,
  1282.     {'$assign_reg'(X, R, Seen, TI0, TI1)},
  1283.     {Seen = yes},
  1284.     [get_con(R, A)],
  1285.     '$gen_get'(Instrs, TI1, TI).
  1286. /* ground$B9`$O(Bstatic term$B$H$7$F8e$G=hM}(B */
  1287. '$gen_get'([A=X|Instrs], TI0, TI) --> {ground(X), X = [X1|X2]}, !,
  1288.     '$gen_put_args'([X1,X2], _, TI0, TI1),
  1289.     {'$assign_reg'(X, R, Seen, TI1, TI2)},
  1290.     {Seen = yes},
  1291.     [get_ground(R, A)],
  1292.     '$gen_get'(Instrs, TI2, TI).
  1293. /* ground$B9`$O(Bstatic term$B$H$7$F8e$G=hM}(B */
  1294. '$gen_get'([A=X|Instrs], TI0, TI) -->
  1295.     {ground(X), X =..[F|Args], functor(X,_,Arity)},
  1296.      !,
  1297.     {'$assign_functor'('$f_n'(F,Arity),  _, TI0, TI00)},
  1298.     '$gen_put_args'(Args, _, TI00, TI1),
  1299.     {'$assign_reg'(X, R, Seen, TI1, TI2)},
  1300.     {Seen = yes},
  1301.     [get_ground(R, A)],
  1302.     '$gen_get'(Instrs, TI2, TI).
  1303. '$gen_get'([A=X|Instrs], TI0, TI) --> {X = [X1|X2]}, !,
  1304.     [get_list(A, UnifyCode)],
  1305.     {'$gen_unify'([X1,X2], Instrs1, TI0, TI1, UnifyCode, [])},
  1306.     '$gen_get'(Instrs1, TI1, TI2),
  1307.     '$gen_get'(Instrs, TI2, TI).
  1308. '$gen_get'([A=X|Instrs], TI0, TI) -->
  1309.     {X =.. [F|Args], functor(X,_,Arity)},
  1310.     {'$assign_functor'('$f_n'(F,Arity), R, TI0, TI1)},
  1311.     [get_str(R, A, UnifyCode)],
  1312.     {'$gen_unify'(Args, Instrs1, TI1, TI2, UnifyCode, [])},
  1313.     '$gen_get'(Instrs1, TI2, TI3),
  1314.     '$gen_get'(Instrs, TI3, TI).
  1315.  
  1316. '$gen_get_var'(void, _, _) --> !. /* void$BJQ?t$N>l9g$OL5;k(B */
  1317. %'$gen_get_var'(R, Seen, A) --> {var(Seen)}, !,
  1318. %   {Seen = yes},
  1319. %   [get_var(R, A)].
  1320. '$gen_get_var'(R, _, A) --> [get_val(R, A)].
  1321.  
  1322. '$gen_unify'([], [], TI, TI) --> !.
  1323. '$gen_unify'([X|Xs], Instrs, TI0, TI) --> {var(X)}, !,
  1324.     {'$assign_reg'(X, R, Seen, TI0, TI1)},
  1325.     '$gen_unify_var'(R, Seen),
  1326.     '$gen_unify'(Xs, Instrs, TI1, TI).
  1327.  
  1328. '$gen_unify'([X|_], _, _, _) --> {float(X)}, !,
  1329.     {'$message'([floating,point,numbers,are,not,supported])},{fail}.
  1330. '$gen_unify'([X|Xs], Instrs, TI0, TI) --> {integer(X)}, !,
  1331.     {'$assign_reg'(X, R, Seen, TI0, TI1)},
  1332.     {Seen = yes},
  1333.     [unify_int(R)],
  1334.     '$gen_unify'(Xs, Instrs, TI1, TI).
  1335. '$gen_unify'([X|Xs], Instrs, TI0, TI) --> {atom(X)}, !,
  1336.     {'$assign_reg'(X, R, Seen, TI0, TI1)},
  1337.     {Seen = yes},  
  1338.     [unify_con(R)],
  1339.     '$gen_unify'(Xs, Instrs, TI1, TI).
  1340. '$gen_unify'([X|Xs], Instrs, TI0, TI) --> {ground(X), X = [X1|X2]}, !,
  1341.     '$gen_put_args'([X1,X2], _, TI0, TI1),
  1342.     {'$assign_reg'(X, R, Seen, TI1, TI2)},
  1343.     {Seen = yes},
  1344.     [unify_ground(R)],
  1345.     '$gen_unify'(Xs, Instrs, TI2, TI).
  1346. '$gen_unify'([X|Xs], Instrs, TI0, TI) -->
  1347.     {ground(X), X =..[F|Args], functor(X,_,Arity)},
  1348.      !,
  1349.     {'$assign_functor'('$f_n'(F,Arity), _, TI0, TI00)},
  1350.     '$gen_put_args'(Args, _, TI00, TI1),
  1351.     {'$assign_reg'(X, R, Seen, TI1, TI2)},
  1352.     {Seen = yes},
  1353.     [unify_ground(R)],
  1354.     '$gen_unify'(Xs, Instrs, TI2, TI).
  1355. '$gen_unify'([X|Xs], [R=X|Instrs], TI0, TI) -->
  1356.     {'$assign_reg'(X, R, Seen, TI0, TI1)},
  1357.     '$gen_unify_var'(R, Seen),
  1358.     '$gen_unify'(Xs, Instrs, TI1, TI).
  1359.  
  1360. '$gen_unify_var'(void, _) --> !, [unify_void(1)].
  1361. '$gen_unify_var'(R, Seen) --> {var(Seen)}, !,
  1362.     {Seen = yes}, [unify_var(R)].
  1363. '$gen_unify_var'(R, _) --> [unify_val(R)].
  1364.  
  1365. /*---------------------------------------------------------------
  1366.     put$BL?Na$N@8@.(B
  1367. ---------------------------------------------------------------*/
  1368. '$gen_put'(_, A, _, _) --> {nonvar(A)}, !,
  1369.     {'$message'([A,should,be,an,unbound,variable])},
  1370.     {fail}.
  1371. '$gen_put'(X, A, TI0, TI) --> {var(X)}, !,
  1372.     {'$assign_reg'(X, R, Seen, TI0, TI)},
  1373.     '$gen_put_var'(R, Seen, A).
  1374. '$gen_put'(X, _, _, _) --> {float(X)}, !,
  1375.     {'$message'([floating,point,numbers,are,not,supported])},{fail}.
  1376. '$gen_put'(X, A, TI0, TI) --> {atomic(X)}, !,
  1377.     {'$assign_reg'(X, R, Seen, TI0, TI)},
  1378.     '$gen_put_ground'(R, Seen, A).
  1379. '$gen_put'(X, A, TI0, TI) --> {ground(X), X = [X1|X2]}, !,
  1380.     '$gen_put_args'([X1,X2], _, TI0, TI1),
  1381.     {'$assign_reg'(X, R, Seen, TI1, TI)},
  1382.     '$gen_put_ground'(R, Seen, A).
  1383. '$gen_put'(X, A, TI0, TI) -->
  1384.     {ground(X), X =..[F|Args], functor(X,_,Arity)},
  1385.      !,
  1386.     {'$assign_functor'('$f_n'(F,Arity), _, TI0, TI00)},
  1387.     '$gen_put_args'(Args, _, TI00, TI1),
  1388.     {'$assign_reg'(X, R, Seen, TI1, TI)},
  1389.     '$gen_put_ground'(R, Seen, A).
  1390. '$gen_put'(X, A, TI0, TI) --> {X = [X1|X2]}, !,
  1391.     {'$assign_reg'(_, R, Seen, TI0, TI1)},
  1392.     {Seen = yes, A = R},
  1393.     '$gen_put_args'([X1,X2], [R1,R2], TI1, TI),
  1394.     [put_list(R1, R2, R)].
  1395. '$gen_put'(X, A, TI0, TI) -->
  1396.     {'$assign_reg'(_, R0, Seen, TI0, TI1)},
  1397.     {Seen = yes, A = R0},
  1398.     {X =.. [F|Args], functor(X,_,Arity)},
  1399.     {'$assign_functor'('$f_n'(F,Arity), R, TI1, TI11)},
  1400.     '$gen_put_args'(Args, Rs, TI11, TI2),
  1401.     {TI2 = [XN,SN|Ls]},
  1402.     {SN1 is SN+1, TI = [XN,SN1|Ls]},
  1403.     [put_str_args(Rs, h(SN))],
  1404.     [put_str(R, h(SN), R0)].
  1405.  
  1406. %%%%%%%%%%%%%%%%
  1407. '$assign_functor'(X, R, TI0, TI) :-
  1408.     X = '$f_n'(_, _),
  1409.     '$assign_reg'(X, R, Seen, TI0, TI),
  1410.     nonvar(Seen),
  1411.     R = f(_),
  1412.     !.
  1413. '$assign_functor'(X, R, TI0, TI) :-
  1414.     X = '$f_n'(_, _),
  1415.     TI0 = [AN,SN,PN,Alloc],
  1416.     R = f(SN),
  1417.     SN1 is SN+1,
  1418.     Alloc1 = [[X,R,yes]|Alloc],
  1419.     TI = [AN,SN1,PN,Alloc1].
  1420. %%%%%%%%%%%%%%%%
  1421.  
  1422. '$gen_put_args'([], [], TI, TI) --> !.
  1423. '$gen_put_args'([X|Xs], [R|Rs], TI0, TI) -->
  1424.     '$gen_put'(X, R, TI0, TI1),
  1425.     '$gen_put_args'(Xs, Rs, TI1, TI).
  1426.  
  1427. '$gen_put_var'(void, _, A) --> !, {A = void}.
  1428. '$gen_put_var'(R, Seen, A) --> {var(Seen)}, !,
  1429.     {Seen = yes, R = A},
  1430.     [put_var(R)].
  1431. '$gen_put_var'(R, _, A) --> {R = A}.
  1432.  
  1433. '$gen_put_ground'(R, Seen, A) --> {var(Seen)}, !,
  1434.     {Seen = yes, R = A}.
  1435. '$gen_put_ground'(R, _, A) --> {R = A}.
  1436.  
  1437. /* closure$B4XO"(B */
  1438. '$gen_put_free_vars'(X, A, TI0, TI) --> !,
  1439.     '$gen_put_args'(X, Rs, TI0, TI1),
  1440.     {TI1 = [XN,SN|Ls]},
  1441.     {SN1 is SN+1, TI = [XN,SN1|Ls]},
  1442.     {A = h(SN)},
  1443.     [put_free_vars(Rs, A)].
  1444.  
  1445. '$gen_put_closure'(X, Y, V, TI0, TI) --> !,
  1446.     {'$assign_reg'(_, R, Seen, TI0, TI)},
  1447.     {Seen = yes, V = R},
  1448.     [put_closure(X, Y, R)].
  1449.  
  1450. /* continuation$B%4!<%k(B */
  1451. '$gen_put_cont'(X, V, [AN,SN,PN,Alloc], [AN,SN,PN1,Alloc]) -->
  1452.     {V = p(PN), PN1 is PN + 1},
  1453.     [put_cont(X, V)].
  1454.  
  1455. /*---------------------------------------------------------------
  1456.     ground$B9`$N%3%s%Q%$%k(B
  1457.  ground$B9`$O(BJava$B$G$O(Bstatic$B$J9`$K%H%i%s%9%l!<%H$5$l$k!#(B
  1458. ---------------------------------------------------------------*/
  1459. '$compile_ground'([], []) --> !.
  1460. '$compile_ground'(TermInfo0, [XN,SN,PN]) -->
  1461.     {TermInfo0 = [_,_,_,Alloc]},
  1462.     {'$pickup_ground'(Alloc, Terms, [])},
  1463.      '$gen_static_terms'(Terms, TermInfo0, TermInfo),
  1464.     {TermInfo = [XN,SN,PN,_]}.
  1465.    
  1466. '$pickup_ground'([]) --> !.
  1467. '$pickup_ground'([[X,V,_]|TI]) --> {V = s(_)}, !,
  1468.     '$pickup_ground'(TI),
  1469.     [X=V].
  1470. '$pickup_ground'([[X,V,_]|TI]) --> {V = f(_)}, !,
  1471.     '$pickup_ground'(TI),
  1472.     [X=V].
  1473. '$pickup_ground'([_|TI]) --> '$pickup_ground'(TI).
  1474.  
  1475. '$gen_static_terms'([], TI, TI) --> !.
  1476. '$gen_static_terms'([P|Ps0], TI0, TI) -->
  1477.     '$gen_static'(P, Ps0, Ps, TI0, TI1),
  1478.     '$gen_static_terms'(Ps, TI1, TI).
  1479.  
  1480. '$gen_static'(T=_, _, _, _, _) --> {var(T)}, !,
  1481.     {'$message'([T,should,not,be,an,unbound,variable])}, {fail}.
  1482. '$gen_static'(T=_, _, _, _, _) --> {float(T)}, !,
  1483.     {'$message'([floating,point,numbers,are,not,supported])}, {fail}.
  1484. '$gen_static'(T=R, Ps, Ps, TI, TI) --> {integer(T)}, !,
  1485.     [put_static_int(T, R)].
  1486. '$gen_static'(T=R, Ps, Ps, TI, TI) --> {atom(T)}, !,
  1487.     [put_static_con(T, R)].
  1488. '$gen_static'(T=R, Ps, Ps, TI, TI) --> {ground(T), T = '$f_n'(F, A)}, !,
  1489.     [put_static_con(F, A, R)].
  1490. '$gen_static'(T=R, Ps0, Ps, TI0, TI) --> {T = [X1|X2]}, !,
  1491.     '$gen_static_args'([X1,X2], [R1,R2], Ps0, Ps, TI0, TI),
  1492.     [put_static_list(R1, R2, R)].
  1493. '$gen_static'(T=R0, Ps0, Ps, TI0, TI) -->
  1494.     {T =.. [F|Args], functor(T,_,Arity)},
  1495.     '$gen_static_args'(['$f_n'(F, Arity)|Args], [R|Rs], Ps0, Ps, TI0, TI1),
  1496.     {TI1 = [A,S|Ls]},
  1497.     {S1 is S+1, TI = [A,S1|Ls]},
  1498.     [put_static_str_args(Rs, h(S))],
  1499.     [put_static_str(R, h(S), R0)].
  1500.  
  1501. '$gen_static_args'([], [], Ps, Ps, TI, TI) --> !.
  1502. '$gen_static_args'([X|Xs], [R|Rs], Ps0, Ps, TI0, TI) -->
  1503.     {'$assign_functor'(X, R, TI0, TI1)},
  1504.      !,
  1505.     {'$delete'(Ps0, X=R, Ps1)},  
  1506.      '$gen_static_args'(Xs, Rs, Ps1, Ps, TI1, TI).
  1507. '$gen_static_args'([X|Xs], [R|Rs], Ps0, Ps, TI0, TI) -->
  1508.     {'$assign_reg'(X, R, yes, TI0, TI1)},
  1509.     {'$delete'(Ps0, X=R, Ps1)},  
  1510.      '$gen_static_args'(Xs, Rs, Ps1, Ps, TI1, TI).
  1511.  
  1512. /*---------------------------------------------------------------
  1513.     $B%f!<%F%#%j%F%#(B(Prolog$B$+$iCf4V%3!<%I$^$G(B)
  1514. ---------------------------------------------------------------*/
  1515. '$list_to_string'([], S) :- !, S = ''.
  1516. '$list_to_string'([X|Xs], S) :-
  1517.     name(X, L1),
  1518.     '$list_to_string'(Xs, S1),
  1519.     name(S1, L2),
  1520.     '$append'(L1, L2, L3),
  1521.     name(S, L3).
  1522.  
  1523. '$variables'(X, Vs) :- '$variables'(X, [], Vs).
  1524.  
  1525. '$variables'(X, Vs, Vs) :- var(X), '$memq'(X, Vs), !.
  1526. '$variables'(X, Vs, [X|Vs]) :- var(X), !.
  1527. '$variables'(X, Vs0, Vs0) :- atomic(X), !.
  1528. '$variables'([X|Xs], Vs0, Vs) :- !,
  1529.     '$variables'(X, Vs0, Vs1), '$variables'(Xs, Vs1, Vs).
  1530. '$variables'(X, Vs0, Vs) :- X =.. Xs, '$variables'(Xs, Vs0, Vs).
  1531.  
  1532. '$memq'(X, [Y|_]) :- X==Y, !.
  1533. '$memq'(X, [_|Ys]) :- '$memq'(X, Ys).
  1534.  
  1535. '$flatten_code'([]) --> !.
  1536. '$flatten_code'([(L: C)|Code]) --> !,
  1537.     [L: []],
  1538.     '$flatten_code'([C|Code]).
  1539. '$flatten_code'([Code1|Code2]) --> !,
  1540.     '$flatten_code'(Code1),
  1541.     '$flatten_code'(Code2).
  1542. '$flatten_code'(Code) --> [Code].
  1543.  
  1544. '$append'([], Zs, Zs).
  1545. '$append'([X|Xs], Ys, [X|Zs]) :- '$append'(Xs, Ys, Zs).
  1546.  
  1547. '$message'([]) :- !, nl.
  1548. '$message'([M|Ms]) :- write(M), write(' '), '$message'(Ms).
  1549.  
  1550. '$mymax'(X, Y, Z) :- X1 is X, Y1 is Y, '$max1'(X1, Y1, Z).
  1551.  
  1552. '$max1'(X, Y, X) :- X >= Y, !.
  1553. '$max1'(_, Y, Y).
  1554.  
  1555. '$count_variable'(V, X, 1) :- V == X, !.
  1556. '$count_variable'(_, X, 0) :- var(X), !.
  1557. '$count_variable'(_, X, 0) :- atomic(X), !.
  1558. '$count_variable'(V, [X|Y], N) :- !,
  1559.     '$count_variable'(V, X, N1),
  1560.     '$count_variable'(V, Y, N2),
  1561.     N is N1 + N2.
  1562. '$count_variable'(V, X, N) :-
  1563.     X =.. Xs,
  1564.     '$count_variable'(V, Xs, N).
  1565.  
  1566. /* $B4{$K(Ballocate$B$5$l$F$$$k>l9g(B */
  1567. '$assign_reg'(X, Type, Seen, [AN,SN,PN,Alloc], [AN,SN,PN,Alloc]) :-
  1568.     '$allocated'(Alloc, X, [Type,Seen]),
  1569.     !.
  1570. /* X$B$,(Bground$B9`$N>l9g(B($B8e$G(Bstatic term$B$H$7$F=hM}$5$l$k(B) */
  1571. '$assign_reg'(X, Type, Seen, [AN,SN,PN,Alloc], [AN,SN1,PN,Alloc1]) :-
  1572.     ground(X),
  1573.     !,
  1574.     Type = s(SN),
  1575.     SN1 is SN + 1,
  1576.     Alloc1 = [[X,Type,Seen]|Alloc].
  1577. '$assign_reg'(X, Type, Seen, [AN,SN,PN,Alloc], [AN1,SN,PN,Alloc1]) :-
  1578.     Type = a(AN),
  1579.     AN1 is AN + 1,
  1580.     Alloc1 = [[X,Type,Seen]|Alloc].
  1581.  
  1582. '$allocated'([[V|X]|_], V0, X) :- V == V0, !.
  1583. '$allocated'([_|Alloc], V0, X) :- '$allocated'(Alloc, V0, X).
  1584.  
  1585. '$delete'([X|Xs], X, Ys) :- '$delete'(Xs, X, Ys).
  1586. '$delete'([X|Xs], Z, [X|Ys]) :- X \== Z, '$delete'(Xs, Z, Ys).
  1587. '$delete'([], _, []).
  1588.  
  1589. /*===============================================================
  1590.     $BCf4V%3!<%I$NL?Na0lMw(B
  1591. ===============================================================*/
  1592. /*
  1593. Get Instructions
  1594. ================
  1595.  get_var(X, A)
  1596.  get_val(X, A)
  1597.  get_int(S, A)
  1598.  get_con(S, A)
  1599.  get_list(A, ["list of unify instructions"])
  1600.  get_str(S,  ["list of unify instructions"])
  1601.  get_ground(S, A)
  1602.  
  1603. Unify Instructions
  1604. ==================
  1605.  unify_void(N)
  1606.  unify_var(A)
  1607.  unify_val(A)
  1608.  unify_int(S)
  1609.  unify_con(S)
  1610.  unify_ground(S)
  1611.  
  1612. Put Instructions
  1613. ================
  1614.  put_var(A)
  1615.  put_list(X1, X2, A)
  1616.  put_str_args([A1...AN], H)
  1617.  put_str(S, H, A)
  1618.  put_cont(Pred, R)
  1619.  put_static_int(INT, S)
  1620.  put_static_con(ATOM, S)
  1621.  put_static_con(ATOM, ARITY, S)
  1622.  put_static_list(S1, S2, S)
  1623.  put_static_str_args([S1...SN], H)
  1624.  put_static_str(S1, H, S)
  1625.  put_static_pred(F/A+Op)
  1626.  
  1627. Control Instructions
  1628. ====================
  1629.  execute(X)
  1630.  
  1631. Choice Instructions
  1632. ===================
  1633.  switch_on_term(LV,LI,LC,LS,LL)
  1634.  try(FA+N, FA+T/I)
  1635.  retry(FA+N, FA+T/I)
  1636.  trust(FA+N)
  1637.  
  1638. Special Instructions
  1639. ===================
  1640.  jump(L)
  1641.  
  1642. Resource Instructions
  1643. =====================
  1644.  put_closure(X, Y, R)
  1645.  put_free_vars(Rs, A)
  1646.  pickup_resource(FA,I,L)
  1647.  restore_resource
  1648.  try_resource(FA+M, FA+N)
  1649.  retry_resource(FA+M, FA+N)
  1650.  trust_resource(FA+N)
  1651.  %consume(I,J)
  1652.  %execute_closure(J)
  1653.  consume_and_exec_closure(I)
  1654.  has_more_resource(FA+N)
  1655.  
  1656. Others
  1657. ======
  1658.  cont, void --> special argument
  1659.  Label:[A]
  1660.  constructor(FA)
  1661.  exec_method(FA, VarInfo, Type, Code)
  1662.  extra_methods(FA)
  1663. */
  1664.  
  1665. /*===============================================================
  1666.     $BCf4V%3!<%I$N=PNO(B
  1667. ===============================================================*/
  1668. '$write_intermediate'(_, []) :- !.
  1669. '$write_intermediate'(Out, [Instruction|Instructions]) :- !,
  1670.     '$write_intermediate'(Out, Instruction),
  1671.     '$write_intermediate'(Out, Instructions).
  1672. '$write_intermediate'(Out, comment(Comment)) :- !,
  1673.     write(Out, '%%% '),
  1674.         writeq(Out, Comment),
  1675.     nl(Out).
  1676. '$write_intermediate'(Out, debug(Comment)) :- !,
  1677.     tab(Out, 8),
  1678.     write(Out, '%%% '),
  1679.     writeq(Out, Comment), nl(Out).
  1680. '$write_intermediate'(Out, (Label: Instruction)) :- !,
  1681.     writeq(Out, Label), write(Out, ' :'),
  1682.     nl(Out),
  1683.     '$write_intermediate'(Out, Instruction).
  1684. '$write_intermediate'(Out, exec_method(X, Y, Z, W)) :- !,
  1685.     tab(Out, 8),   
  1686.     write(Out, 'exec_method('),
  1687.     writeq(Out, X), write(Out, ','),
  1688.     writeq(Out, Y), write(Out, ','),
  1689.     writeq(Out, Z), write(Out, ',['),
  1690.     nl(Out),
  1691.     write_imd_exec(Out, W),
  1692.     tab(Out, 8),   
  1693.     write(Out, '].'), nl(Out).
  1694. '$write_intermediate'(Out, Instruction) :-
  1695.     tab(Out, 8),
  1696.     writeq(Out, Instruction), write(Out, '.'),
  1697.     nl(Out).
  1698.  
  1699. write_imd_exec(_, []) :- !.
  1700. write_imd_exec(Out, [P]) :- !,
  1701.     tab(Out, 12),
  1702.     writeq(Out, P), nl(Out).
  1703. write_imd_exec(Out, [P|Ps]) :-
  1704.     tab(Out, 12),
  1705.     writeq(Out, P), write(Out, ','),
  1706.     nl(Out),
  1707.     write_imd_exec(Out, Ps).
  1708.  
  1709. /*===============================================================
  1710.     Java$B%3!<%I$N=PNO(B
  1711. ===============================================================*/
  1712. '$generate_cs'(Out, Code) :-
  1713.     %'$write_cs'(Out, Code),
  1714.     '$write_cs0'(Out, Code),
  1715.     write(Out, '}'),
  1716.     nl(Out),
  1717.     write(Out, '}'), % added by JJC to close the namespace (hope this is right).
  1718.     nl(Out).   
  1719.  
  1720. '$write_cs0'(Out, Instructions) :-
  1721.     '$member'(Instr, Instructions),
  1722.     '$write_cs'(Out, Instr),
  1723.     fail.
  1724. '$write_cs0'(_, _) :- !.
  1725.  
  1726. '$print_release_message'(Out, FA) :-
  1727.     '$version'(Version),
  1728.     '$file_name'(File),
  1729.     '$create_class_name'(FA, Class),
  1730.     '$writeln_stream'(Out, 0, ['/*']),
  1731.     '$writeln_stream'(Out, 0, [' * *** Please do not edit ! ***']),
  1732.     '$writeln_stream'(Out, 0, [' * @(#) ', Class, '.cs']), 
  1733.     '$writeln_stream'(Out, 0, [' * @procedure ', FA, ' in ', File, '.pl']),
  1734.     '$writeln_stream'(Out, 0, [' */']),
  1735.     nl(Out),
  1736.     '$writeln_stream'(Out, 0, ['/*']),
  1737.     '$writeln_stream'(Out, 0, [' * @version ', Version]),
  1738.     '$writeln_stream'(Out, 0, [' * @author Mutsunori Banbara (banbara@pascal.seg.kobe-u.ac.jp)']),
  1739.     '$writeln_stream'(Out, 0, [' * @author Naoyuki Tamura    (tamura@kobe-u.ac.jp)']),
  1740.     '$writeln_stream'(Out, 0, [' * Modified by Jonathan Cook (jjc@dcs.ed.ac.uk)']),
  1741.     '$writeln_stream'(Out, 0, [' */']).
  1742.  
  1743. '$write_cs'(_, []) :- !.
  1744. %'$write_cs'(Out, [Instruction|Instructions]) :- !,
  1745. %   '$write_cs'(Out, Instruction),
  1746. %   '$write_cs'(Out, Instructions).
  1747.  
  1748. /*---------------------------------------------------------------
  1749.     $B%3%a%s%H(B
  1750. ---------------------------------------------------------------*/
  1751. '$write_cs'(_, comment(_)) :- !.
  1752. '$write_cs'(_, debug(_)) :- !.
  1753. %'$write_cs'(Out, comment(Comment)) :- !,
  1754. %   write(Out, '// '),
  1755. %   writeq(Out, Comment), nl(Out).
  1756. %
  1757. %'$write_cs'(Out, debug(Comment)) :- !,
  1758. %   tab(Out, 8),
  1759. %   write(Out, '// '),
  1760. %   writeq(Out, Comment), nl(Out).
  1761.  
  1762. /*---------------------------------------------------------------
  1763.     $B%/%i%9@k8@(B
  1764. ---------------------------------------------------------------*/
  1765.  
  1766. /* JJC
  1767.  * extends -> :
  1768.  * final -> sealed or readonly
  1769.  * putting in overrides/virutals
  1770.  * toString -> ToString
  1771.  * namespace declarations, not yet *closed*
  1772.  */
  1773.  
  1774. '$write_cs'(Out, (Label: Instruction)) :- !,
  1775.     '$write_cs_class'(Out, Label),
  1776.     '$write_cs'(Out, Instruction).
  1777.  
  1778. '$write_cs_class'(Out, Label) :- Label = '$res'(_,_), !,
  1779.     '$print_release_message'(Out, Label),
  1780.     '$create_class_name'(Label, N),
  1781.     '$writeln_stream'(Out, 0, ['namespace JJC.Psharp.Resources {'] ), %JJC
  1782.     '$writeln_stream'(Out, 0, [] ), %JJC
  1783.     '$writeln_stream'(Out, 0, ['using JJC.Psharp.Lang;'] ),
  1784.     '$writeln_stream'(Out, 0, ['using JJC.Psharp.Lang.Resource;'] ), %JJC
  1785.     '$writeln_stream'(Out, 0, ['using Predicates = JJC.Psharp.Predicates;'] ), %JJC
  1786.     '$writeln_stream'(Out, 0, ['using Resources = JJC.Psharp.Resources;'] ), %JJC
  1787.     '$writeln_stream'(Out, 0, [] ), %JJC
  1788.     '$writeln_stream'(Out, 0, ['public sealed class ', N, ' : Predicate {']).
  1789.  
  1790. '$write_cs_class'(Out, Label) :- Label = F/A, !,
  1791.     '$print_release_message'(Out, Label),
  1792.     '$create_class_name'(F/A, N),
  1793.     '$writeln_stream'(Out, 0, ['namespace JJC.Psharp.Predicates {'] ), %JJC
  1794.     '$writeln_stream'(Out, 0, [] ), %JJC
  1795.     '$writeln_stream'(Out, 0, ['using JJC.Psharp.Lang;'] ),
  1796.         '$writeln_stream'(Out, 0, ['using JJC.Psharp.Lang.Resource;'] ),  %JJC
  1797.     '$writeln_stream'(Out, 0, ['using Predicates = JJC.Psharp.Predicates;'] ), %JJC
  1798.     '$writeln_stream'(Out, 0, ['using Resources = JJC.Psharp.Resources;'] ), %JJC
  1799.     '$writeln_stream'(Out, 0, [] ), % this and following four lines: JJC
  1800.     (   clause('$fco_predicates'(F,A),_) ->
  1801.         '$writeln_stream'(Out, 0, ['public class ', N, ' : Predicate, FcoPredicate {'])
  1802.         ; '$writeln_stream'(Out, 0, ['public class ', N, ' : Predicate {'])
  1803.       ).
  1804.  
  1805.     % '$writeln_stream'(Out, 0, ['public class ', N, ' : Predicate {']). % ,  GOAL REMOVED JJC
  1806.     % (    clause('$fco_predicates'(F,A),_) ->
  1807.     %     '$writeln_stream'(Out, 4, ['static internal ', N, ' entry_code;'])
  1808.     % ;    true
  1809.     % ).
  1810.  
  1811. '$write_cs_class'(Out, Label) :- Label = FA+Type,
  1812.     write(Out, '}'), nl(Out), nl(Out),
  1813.     '$create_class_name'(FA+Type, N1),
  1814.     '$create_class_name'(FA, N2),
  1815.     '$writeln_stream'(Out, 0, ['sealed class ', N1, ' : ', N2, ' {']).
  1816.  
  1817. /*---------------------------------------------------------------
  1818.     static$BJQ?t$N@k8@(B
  1819. ---------------------------------------------------------------*/
  1820. '$write_cs'(Out, put_static_pred(FA)) :- !,
  1821.     '$create_pred_name'(FA, Pred),
  1822.     '$create_qualified_name'(FA, Class),
  1823.     '$writeln_stream'(Out,
  1824.                    4,
  1825.                    ['static internal readonly Predicate ',
  1826.                    Pred, ' = new ', Class, '();'
  1827.                ]).
  1828.  
  1829. '$write_cs'(Out, put_static_con(Atom, S)) :- atom(Atom), !,
  1830.     '$create_reg_name'(S, SN),
  1831.     '$atom_to_string'(Atom, String),
  1832.     '$writeln_stream'(Out,
  1833.                    4,
  1834.                ['static internal readonly SymbolTerm ',
  1835.             SN, ' = SymbolTerm.makeSymbol("', String, '");'
  1836.                ]).
  1837.  
  1838. '$write_cs'(Out, put_static_con(Atom, Arity, S)) :- atom(Atom), integer(Arity),!,
  1839.     '$create_reg_name'(S, SN),
  1840.     '$atom_to_string'(Atom, String),
  1841.     '$writeln_stream'(Out,
  1842.                    4,
  1843.                ['static internal readonly SymbolTerm ',
  1844.             SN, ' = SymbolTerm.makeSymbol("', String, '"', ', ', Arity, ');'
  1845.                ]).
  1846.  
  1847. '$write_cs'(Out, put_static_int(Int, S)) :- integer(Int), !,
  1848.     '$create_reg_name'(S, SN),
  1849.     '$writeln_stream'(Out,
  1850.                    4,
  1851.                    ['static internal readonly IntegerTerm ',
  1852.             SN, ' = new IntegerTerm(', Int, ');'
  1853.                ]).
  1854.  
  1855. '$write_cs'(Out, put_static_list(S1, S2, S)) :- !,
  1856.     '$create_reg_name'(S, SN),
  1857.     '$create_reg_name'(S1, SN1),
  1858.     '$create_reg_name'(S2, SN2),
  1859.     '$writeln_stream'(Out,
  1860.                    4,
  1861.                ['static internal readonly ListTerm ',
  1862.             SN, ' = new ListTerm(', SN1, ', ', SN2, ');'
  1863.                ]).
  1864.  
  1865. '$write_cs'(Out, put_static_str(S1, H, S)) :- !,
  1866.     '$create_reg_name'(S, SN),
  1867.     '$create_reg_name'(H, HN),
  1868.     '$create_reg_name'(S1, SN1),
  1869.     '$writeln_stream'(Out,
  1870.                        4,
  1871.                ['static internal readonly StructureTerm ',
  1872.             SN, ' = new StructureTerm(', SN1, ', ', HN, ');'
  1873.                ]).
  1874.  
  1875. '$write_cs'(Out, put_static_str_args(Ss, H)) :- !,
  1876.     '$create_reg_name'(H, HN),
  1877.     '$create_str_args'(Ss, SNs),
  1878.     '$writeln_stream'(Out, 4, ['static internal readonly Term[] ', HN, ' = '|SNs]).
  1879.  
  1880. /*---------------------------------------------------------------
  1881.     $B%3%s%9%H%i%/%?(B
  1882. ---------------------------------------------------------------*/
  1883. '$write_cs'(Out, constructor(FA)) :-  FA = '$res'(_,_), !,
  1884.     '$create_class_name'(FA, Name),
  1885.     '$writeln_stream'(Out, 4, ['public ', Name, '(){}']).
  1886.  
  1887. '$write_cs'(Out, constructor(F/A)) :- !,
  1888.     '$wj_public_arg_decl'(Out, A), /* local$B$J0z?t$h$&$NJQ?t$N@k8@(B */
  1889.          nl(Out),  
  1890.     '$create_class_name'(F/A, Name),
  1891.      tab(Out, 4),
  1892.     '$writel_stream'(Out, ['public ', Name, '(']), /* $BIaDL$N%3%s%9%H%i%/%?(B */
  1893.     '$wj_assign_number'(Out, A, 'Term a', 1, ', '),
  1894.      write(Out, 'Predicate cont) {'),  
  1895.      nl(Out),  
  1896.     '$wj_constructor_args'(Out, 1, A),
  1897.     '$writeln_stream'(Out, 4, ['}']),
  1898.      nl(Out),  
  1899.      /* call/1$BMQ$N0z?t$J$7$N%3%s%9%H%i%/%?(B */
  1900.     '$writeln_stream'(Out, 4, ['public ', Name, '(){}']),
  1901.     '$writeln_stream'(Out, 4, ['public override void setArgument(Term[] args, Predicate cont) {']),
  1902.     '$wj_constructor_args_for_call'(Out, 0, A),
  1903.     '$writeln_stream'(Out, 4, ['}']).
  1904.  
  1905. '$wj_public_arg_decl'(_, Arity) :- Arity =< 0, !.
  1906. '$wj_public_arg_decl'(Out, Arity) :- Arity > 0,
  1907.     nl(Out),
  1908.     tab(Out, 4),
  1909.     write(Out, 'public Term '),
  1910.     '$wj_assign_number'(Out, Arity, 'arg', 1, ';'),
  1911.     nl(Out).
  1912.  
  1913. '$wj_constructor_args'(Out, N, Arity) :- N > Arity, !,
  1914.     '$writeln_stream'(Out, 8, ['this.cont = cont;']).
  1915. '$wj_constructor_args'(Out, N, Arity) :-
  1916.     '$writeln_stream'(Out, 8, ['arg', N, ' = ', 'a',  N, '; ']),
  1917.     M is N + 1,
  1918.     '$wj_constructor_args'(Out, M, Arity).
  1919.  
  1920. '$wj_constructor_args_for_call'(Out, N, A) :- N > A-1, !,
  1921.     '$writeln_stream'(Out, 8, ['this.cont = cont;']).
  1922. '$wj_constructor_args_for_call'(Out, N, A) :-
  1923.     M is N + 1,
  1924.     '$writeln_stream'(Out, 8, ['arg', M, ' = ', 'args[', N, ']; ']),
  1925.     '$wj_constructor_args_for_call'(Out, M, A).
  1926.  
  1927. /*---------------------------------------------------------------
  1928.     exec$B%a%=%C%I(B
  1929. exec_method(Functor/Arity, VarInfo, Type, Code))
  1930.     * VarInfo = [AVars, Pvars] or []
  1931.         * Type = root, top, normal, try, retry, trust
  1932.  
  1933.     [exec_method(FA, [AVar,PVar], root_nores, ExecCode)],
  1934. ---------------------------------------------------------------*/
  1935. '$write_cs'(Out, exec_method(_, _, T, [execute(cont)])) :- !,  
  1936.     nl(Out),
  1937.     '$writeln_stream'(Out, 4, ['public override Predicate exec( Prolog engine ) {']), % argument added JJC
  1938.     (  T == root_one_nores ->
  1939.          '$writeln_stream'(Out, 8, ['return cont;'])
  1940.       ;
  1941.          '$writeln_stream'(Out, 8, ['return engine.cont;'])
  1942.     ),
  1943.     '$writeln_stream'(Out, 4, ['}']).
  1944. '$write_cs'(Out, exec_method(Functor/Arity, VarInfo, Type, Code)) :- !,
  1945.     nl(Out),
  1946.     '$write_cs_exec'(Out, Functor, Arity, VarInfo, Type),
  1947.     %'$write_cs'(Out, Code),
  1948.     '$write_cs0'(Out, Code),
  1949.     '$writeln_stream'(Out, 4, ['}']).
  1950.  
  1951. '$write_cs_exec'(Out, _, _, VarInfo, res(N))  :- !,
  1952.     '$wj_exec_normal'(Out, N, VarInfo).
  1953. '$write_cs_exec'(Out, Functor, Arity, _, root) :- !,
  1954.     '$wj_exec_root'(Out, Functor, Arity).
  1955. '$write_cs_exec'(Out, Functor, Arity, _, root_nores) :- !,
  1956.     '$wj_exec_root'(Out, Functor, Arity).
  1957. '$write_cs_exec'(Out, Functor, Arity, VarInfo, root_one_nores)  :- !,
  1958.     '$wj_exec_root_one_nores'(Out, Functor, Arity, VarInfo).
  1959. '$write_cs_exec'(Out, _, Arity, VarInfo, normal)  :- !,
  1960.     '$wj_exec_normal'(Out, Arity, VarInfo).
  1961. '$write_cs_exec'(Out, _, _, [], top)  :- !,
  1962.     '$writeln_stream'(Out, 4, ['public override Predicate exec( Prolog engine ) {']). % argument added JJC
  1963.     %'$writeln_stream'(Out, 8, ['engine.setB0();']).
  1964. '$write_cs_exec'(Out, _, Arity, VarInfo, top)  :- !,
  1965.     '$wj_exec_normal'(Out, Arity, VarInfo).
  1966.     %'$writeln_stream'(Out, 8, ['engine.setB0();']).
  1967. '$write_cs_exec'(Out, _, _, _, _)  :-
  1968.     '$writeln_stream'(Out, 4, ['public override Predicate exec( Prolog engine ) {']). % argument added JJC
  1969.  
  1970. /* root */
  1971. '$wj_exec_root'(Out, Functor, Arity) :-
  1972.     '$writeln_stream'(Out, 4, ['public override Predicate exec( Prolog engine ) {']),  % argument added JJC
  1973.     (    clause('$fco_predicates'(Functor,Arity),_) ->
  1974.          '$writeln_stream'(Out, 8, ['engine.SetEntryCode( this );']) % JJC: engine. added
  1975.     ;    true
  1976.     ),
  1977.     '$wj_root_args'(Out, 1, Arity),
  1978.     '$writeln_stream'(Out, 4, ['}']), nl(Out),
  1979.     '$writeln_stream'(Out, 4, ['public virtual Predicate call( Prolog engine ) {']), % argument added JJC
  1980.     '$writeln_stream'(Out, 8, ['engine.setB0();']).
  1981.  
  1982. '$wj_root_args'(Out, N, Arity) :- N > Arity, !,
  1983.     '$writeln_stream'(Out, 8, ['engine.cont = cont;']),
  1984.     '$writeln_stream'(Out, 8, ['return call( engine );']). % added engine
  1985. '$wj_root_args'(Out, N, Arity) :-
  1986.     '$writeln_stream'(Out, 8, ['engine.aregs[', N, '] = ', 'arg', N, ';']),
  1987.     M is N + 1,
  1988.     '$wj_root_args'(Out, M, Arity).
  1989.  
  1990. /* root_one_nores */
  1991. '$wj_exec_root_one_nores'(Out, Functor, Arity, [AN, PN]) :- !,
  1992.     '$writeln_stream'(Out, 4, ['public override Predicate exec( Prolog engine ) {']), % argument added JJC
  1993.  
  1994.  
  1995.     '$writeln_stream'(Out, 8, ['engine.setB0();']),
  1996.     %(    clause('$fco_predicates'(Functor,Arity),_) ->
  1997.     %     '$writeln_stream'(Out, 8, ['entry_code = engine.GetEntryCode( this );'])
  1998.     %;    true
  1999.     %),
  2000.     (    clause('$fco_predicates'(Functor,Arity),_) ->
  2001.          '$message'([procedure,Functor/Arity,contains,an,infinite,loop]), abort    % spelling mistake corrected JJC
  2002.     ;    true
  2003.     ),
  2004.     '$wj_a_register'(Out, AN),
  2005.     '$wj_p_register'(Out, PN),
  2006.     '$wj_deref_one'(Out, 1, Arity),
  2007.     nl(Out).
  2008.  
  2009. '$wj_deref_one'(_, N, Arity) :- N > Arity, !.
  2010. '$wj_deref_one'(Out, N, Arity) :-
  2011.     '$writeln_stream'(Out, 8, ['a',N,' = ','arg', N, '.dereference();']),
  2012.     M is N + 1,
  2013.     '$wj_deref_one'(Out, M, Arity).
  2014.  
  2015. /* normal */
  2016. '$wj_exec_normal'(_, _, []) :- !.
  2017. '$wj_exec_normal'(Out, Arity, [AN, PN]) :-
  2018.     '$writeln_stream'(Out, 4, ['public override Predicate exec( Prolog engine ) {']), % argument added JJC
  2019.     '$wj_a_register'(Out, AN),
  2020.     '$wj_p_register'(Out, PN),
  2021.     '$wj_deref'(Out, 1, Arity),
  2022.     nl(Out).
  2023.  
  2024. '$wj_deref'(Out, N, Arity) :- N > Arity, !,
  2025.     '$writeln_stream'(Out, 8, ['Predicate cont = engine.cont;']).  %%%% THIS IS THE ONE YOU WANT TO CHANGE
  2026. '$wj_deref'(Out, N, Arity) :-
  2027.     '$writeln_stream'(Out, 8, ['a',N,' = ','engine.aregs[', N, '].dereference();']),
  2028.     M is N + 1,
  2029.     '$wj_deref'(Out, M, Arity).
  2030.  
  2031. '$wj_a_register'(_, N) :- N =< 1, !.
  2032. '$wj_a_register'(Out, N) :- M is N-1,
  2033.     tab(Out, 8),
  2034.     write(Out, 'Term '),
  2035.     '$wj_assign_number'(Out, M, a, 1, ;),
  2036.     nl(Out).
  2037.  
  2038. '$wj_p_register'(_, N) :- N =< 1, !.
  2039. '$wj_p_register'(Out, N) :- M is N-1,
  2040.     tab(Out, 8),
  2041.     write(Out, 'Predicate '),
  2042.     '$wj_assign_number'(Out, M, p, 1, ;),
  2043.     nl(Out).
  2044.  
  2045. /*---------------------------------------------------------------
  2046.     Indexing$BL?Na(B(switch_on_term, try, retry, truct)
  2047. ---------------------------------------------------------------*/
  2048. '$write_cs'(Out, switch_on_term(LV, LI, LC, LS, LL)) :- !,
  2049.     '$create_pred_name'(LV, N1),
  2050.     '$create_pred_name'(LI, N2),
  2051.     '$create_pred_name'(LC, N3),
  2052.     '$create_pred_name'(LS, N4),
  2053.     '$create_pred_name'(LL, N5),
  2054.     '$writeln_stream'(Out, 8, ['return engine.switch_on_term(']),
  2055.     '$writeln_stream'(Out, 35, [N1, ',']),
  2056.     '$writeln_stream'(Out, 35, [N2, ',']),
  2057.     '$writeln_stream'(Out, 35, [N3, ',']),
  2058.     '$writeln_stream'(Out, 35, [N4, ',']),
  2059.     '$writeln_stream'(Out, 35, [N5]),
  2060.     '$writeln_stream'(Out, 35, [');']).
  2061.  
  2062. '$write_cs'(Out, try(L1, L2)) :- !,
  2063.     '$create_pred_name'(L1, N1),
  2064.     '$create_pred_name'(L2, N2),
  2065.     '$writeln_stream'(Out, 8, ['return engine.jtry(', N1, ', ', N2, ');']).
  2066.  
  2067. '$write_cs'(Out, retry(L1, L2)) :- !,
  2068.     '$create_pred_name'(L1, N1),
  2069.     '$create_pred_name'(L2, N2),
  2070.     '$writeln_stream'(Out, 8, ['return engine.retry(', N1, ', ', N2, ');']).
  2071.  
  2072. '$write_cs'(Out, trust(L)) :- !,
  2073.     '$create_pred_name'(L, N),
  2074.     '$writeln_stream'(Out, 8, ['return engine.trust(', N, ');']).
  2075.  
  2076. /*---------------------------------------------------------------
  2077.     $B$H$j$"$($:(B
  2078. ---------------------------------------------------------------*/
  2079. '$write_cs'(Out, jump(L)) :- !,
  2080.     '$create_pred_name'(L, N),
  2081.     '$writeln_stream'(Out, 8, ['return ', N, ';']).
  2082.  
  2083. /*---------------------------------------------------------------
  2084.     $B$=$NB>$N%a%=%C%I=PNO(B
  2085.   * arity()
  2086.   * toString()
  2087. ---------------------------------------------------------------*/
  2088. '$write_cs'(Out, extra_methods(FA)) :- FA = '$res'(_F/A, _), !,
  2089.     '$write_cs_arity'(Out, A),
  2090.     '$create_pred_name'(FA, Name),
  2091.     '$write_cs_toString'(Out, Name, 0).
  2092. '$write_cs'(Out, extra_methods(FA)) :- FA = F/A, !,
  2093.     '$write_cs_arity'(Out, A),
  2094.     '$write_cs_toString'(Out, F, A).
  2095.  
  2096. '$write_cs_arity'(Out, A) :-
  2097.     nl(Out),
  2098.     '$writeln_stream'(Out,4,['public override int arity() { return ', A, ';', ' }']).
  2099.  
  2100. '$write_cs_toString'(Out, F, A) :-
  2101.     nl(Out),
  2102.     '$atom_to_string'(F, F1),
  2103.     '$wj_toString_args'(F1, A, Args),
  2104.     '$writeln_stream'(Out, 4, ['public override string ToString() {']),
  2105.     '$writeln_stream'(Out, 8, ['return '|Args]),
  2106.     '$writeln_stream'(Out, 4, ['}']).
  2107.  
  2108. '$wj_toString_args'(F, A, As) :- A =:= 0, !,
  2109.     As = ['"', F, '";'].
  2110. '$wj_toString_args'(F, A, As) :- A > 0,
  2111.     '$wj_toString_args0'(A, [], As0),
  2112.     '$append'(['"', F, '(" + '|As0], [' + ")";'], As).
  2113.  
  2114. '$wj_toString_args0'(A, X, Y) :- A =:= 1, !,
  2115.     Y = ['arg', A|X].
  2116. '$wj_toString_args0'(A, X, Y) :- A > 1,
  2117.     A1 is A-1,
  2118.     '$wj_toString_args0'(A1, [' + ', '", "', ' + ', 'arg', A|X], Y).
  2119.  
  2120. /*---------------------------------------------------------------
  2121.     get$BL?Na$N=PNO(B
  2122. ---------------------------------------------------------------*/
  2123. '$write_cs'(Out, get_var(X, A)) :- !,
  2124.     '$create_reg_name'(X, X1),
  2125.     '$create_reg_name'(A, A1),
  2126.     '$writeln_stream'(Out, 8, [X1, ' = ', A1, ';']).
  2127.  
  2128. '$write_cs'(Out, get_val(X, A)) :- !, '$write_cs_get4'(Out, X, A).
  2129. '$write_cs'(Out, get_con(S, A)) :- !, '$write_cs_get4'(Out, S, A).
  2130. '$write_cs'(Out, get_int(S, A)) :- !, '$write_cs_get4'(Out, S, A).
  2131. '$write_cs'(Out, get_ground(S, A)) :- !, '$write_cs_get4'(Out, S, A).
  2132.  
  2133. '$write_cs_get4'(Out, X, A) :-
  2134.     '$create_reg_name'(X, X1),
  2135.     '$create_reg_name'(A, A1),
  2136.     '$writeln_stream'(Out,
  2137.                    8,
  2138.                ['if ( !', X1, '.unify(', A1, ', ',
  2139.             'engine.trail) ) return engine.fail();'
  2140.                ]).
  2141.  
  2142. /*---------------------------------------------------------------
  2143.     get_list$BL?Na(B
  2144. ---------------------------------------------------------------*/
  2145. '$write_cs'(Out, get_list(X, UnifyInstr)) :- !,
  2146.     '$create_reg_name'(X, A),
  2147.     '$writeln_stream'(Out, 8, ['if ( ', A, '.isList() ){']),   
  2148.     '$wj_get_list_read'(Out, A, UnifyInstr),
  2149.     '$writeln_stream'(Out, 8, ['} else if ( ', A, '.isVariable() ){']),
  2150.     '$wj_get_list_write'(Out, A, UnifyInstr),
  2151.     '$writeln_stream'(Out, 8, ['} else {']),
  2152.     '$writeln_stream'(Out, 12, ['return engine.fail();']),
  2153.     '$writeln_stream'(Out, 8, ['}']).
  2154.  
  2155. /* read$B%b!<%I(B */
  2156. '$wj_get_list_read'(Out, A, [U1, U2]) :-
  2157.     '$unify_list_r'(Out, car, A, U1),
  2158.     '$unify_list_r'(Out, cdr, A, U2).
  2159.  
  2160. '$unify_list_r'(_, _, _, unify_void(_))  :- !.
  2161. '$unify_list_r'(Out, C, A, unify_var(X)) :- !,
  2162.     '$create_reg_name'(X, Y),
  2163.     '$writeln_stream'(Out,
  2164.                    12,
  2165.                [Y, ' = ', '((ListTerm)', A, ').', C, ';'
  2166. % removed a () before the ;
  2167.                ]).
  2168. '$unify_list_r'(Out, C, A, unify_val(X)) :- !, '$unify_list_r4'(Out, C, A, X).
  2169. '$unify_list_r'(Out, C, A, unify_int(X)) :- !, '$unify_list_r4'(Out, C, A, X).
  2170. '$unify_list_r'(Out, C, A, unify_con(X)) :- !, '$unify_list_r4'(Out, C, A, X).
  2171. '$unify_list_r'(Out, C, A, unify_ground(X)) :- !, '$unify_list_r4'(Out, C, A, X).
  2172.  
  2173. '$unify_list_r4'(Out, C, A, X) :-
  2174.     '$create_reg_name'(X, Y),
  2175.     '$writeln_stream'(Out,
  2176.                    12,
  2177. % removed a () in what is now ''
  2178.                ['if ( !', Y, '.unify(((ListTerm)', A, ').', C, '',
  2179.                                    ', ',
  2180.                            'engine.trail) )'
  2181.                ]),
  2182.     '$writeln_stream'(Out, 16, ['return engine.fail();']).
  2183.  
  2184. /* write$B%b!<%I(B */
  2185. '$wj_get_list_write'(Out, A, [U1, U2]) :-
  2186.     '$unify_list_w'(Out, U1, Car),
  2187.     '$unify_list_w'(Out, U2, Cdr),
  2188.     '$writeln_stream'(Out,
  2189.                    12,
  2190.                ['if ( !', A, '.unify(new ListTerm(',
  2191.             Car, ', ', Cdr, '), ', 'engine.trail) )']),
  2192.     '$writeln_stream'(Out, 16, ['return engine.fail();']).
  2193.  
  2194. %'$unify_list_w'(_, unify_void(_), C) :- !, C = 'new VariableTerm()'.
  2195. '$unify_list_w'(_, unify_void(_), C) :- !, C = 'engine.makeVariable()'.
  2196. '$unify_list_w'(Out, unify_var(X), Y) :- !,
  2197.     '$create_reg_name'(X, Y),
  2198.     '$writeln_stream'(Out, 12, [Y, ' = engine.makeVariable();']).
  2199.     %'$writeln_stream'(Out, 12, [Y, ' = new VariableTerm();']).
  2200. '$unify_list_w'(_, unify_val(X), Y) :- !, '$create_reg_name'(X, Y).
  2201. '$unify_list_w'(_, unify_int(X), Y) :- !, '$create_reg_name'(X, Y).
  2202. '$unify_list_w'(_, unify_con(X), Y) :- !, '$create_reg_name'(X, Y).
  2203. '$unify_list_w'(_, unify_ground(X), Y) :- !, '$create_reg_name'(X, Y).
  2204.  
  2205. /*---------------------------------------------------------------
  2206.     get_str$BL?Na(B
  2207. ---------------------------------------------------------------*/
  2208. '$write_cs'(Out, get_str(R, A, UnifyInstr)) :- !,
  2209.     '$create_reg_name'(A, N1),
  2210.     '$create_reg_name'(R, N2),
  2211.     /* read$B%b!<%I(B */
  2212.     '$writeln_stream'(Out,  8, ['if ( ', N1, '.isStructure() ){']),
  2213.     %'$writeln_stream'(Out,
  2214.         %                   12,
  2215.     %          ['StructureTerm str = (StructureTerm)', N1, ';']),
  2216.     '$writeln_stream'(Out,
  2217.                    12,
  2218.                ['if (', N2, ' != ((StructureTerm)', N1, ').functor )']),
  2219.     '$writeln_stream'(Out,  16, ['return engine.fail();']),
  2220.     '$writeln_stream'(Out,
  2221.                    12,
  2222.                ['Term[] args = ((StructureTerm)',
  2223.             N1, ').args;']),
  2224.  
  2225.     '$wj_get_str_read'(Out, UnifyInstr, 0),
  2226.     /* write$B%b!<%I(B */
  2227.     '$writeln_stream'(Out,  8, ['} else if (', N1, '.isVariable() ){']),
  2228.     '$wj_get_str_write'(Out, N1, N2, UnifyInstr),
  2229.     '$writeln_stream'(Out,  8, ['} else {']),
  2230.     '$writeln_stream'(Out, 12, ['return engine.fail();']),
  2231.     '$writeln_stream'(Out,  8, ['}']).
  2232.  
  2233. /* read$B%b!<%I(B */
  2234. '$wj_get_str_read'(_, [], _) :- !.
  2235. '$wj_get_str_read'(Out, [U|Us], I) :-
  2236.     '$unify_str_r'(Out, U, I),
  2237.     I1 is I+1,
  2238.     '$wj_get_str_read'(Out, Us, I1).
  2239.  
  2240. '$unify_str_r'(_,   unify_void(_), _) :- !.
  2241. '$unify_str_r'(Out, unify_var(X),  I) :- !,
  2242.     '$create_reg_name'(X, A),
  2243.     '$writeln_stream'(Out, 12, [A, ' = args[', I, '];']).
  2244. '$unify_str_r'(Out, unify_val(X), I) :- !, '$unify_str_r4'(Out, X, I).
  2245. '$unify_str_r'(Out, unify_int(X), I) :- !, '$unify_str_r4'(Out, X, I).
  2246. '$unify_str_r'(Out, unify_con(X), I) :- !, '$unify_str_r4'(Out, X, I).
  2247. '$unify_str_r'(Out, unify_ground(X), I) :- !, '$unify_str_r4'(Out, X, I).
  2248.  
  2249. '$unify_str_r4'(Out, X, I) :-
  2250.     '$create_reg_name'(X, A),
  2251.     '$writeln_stream'(Out,
  2252.                    12,
  2253.                ['if ( !', A,
  2254.             '.unify(args[', I, '],  engine.trail) )']),
  2255.     '$writeln_stream'(Out, 16, ['return engine.fail();']).
  2256.  
  2257. /* write$B%b!<%I(B */
  2258. '$wj_get_str_write'(Out, A, Func, UnifyInstr) :- !,
  2259.     '$unify_str_write'(Out, UnifyInstr, Args),
  2260.     '$writeln_stream'(Out, 12, ['Term[] args = '|Args]),
  2261.     '$writeln_stream'(Out,
  2262.                    12,
  2263.                ['if ( !', A,
  2264.             '.unify(new StructureTerm(',
  2265.             Func, ', args), engine.trail) )']),
  2266.     '$writeln_stream'(Out, 16, ['return engine.fail();']).
  2267.  
  2268. '$unify_str_write'(Out, UnifyInstr, Args) :-
  2269.     '$unify_str_w'(Out, UnifyInstr, Y),
  2270.     '$append'(['{'|Y], ['};'], Args).
  2271.  
  2272. '$unify_str_w'(Out, [U], [A]) :- !,
  2273.     '$unify_str_w0'(Out, U, A).
  2274. '$unify_str_w'(Out, [U|Us], [A, ', '|As]) :-
  2275.     '$unify_str_w0'(Out, U, A),
  2276.     '$unify_str_w'(Out, Us, As).
  2277.  
  2278. %'$unify_str_w0'(_, unify_void(_), X) :- !, X = 'new VariableTerm()'.
  2279. '$unify_str_w0'(_, unify_void(_), X) :- !, X = 'engine.makeVariable()'.
  2280. '$unify_str_w0'(Out, unify_var(X), A) :- !,
  2281.     '$create_reg_name'(X, A),
  2282.     '$writeln_stream'(Out, 12, [A, ' = engine.makeVariable();']).
  2283.     %'$writeln_stream'(Out, 12, [A, ' = new VariableTerm();']).
  2284. '$unify_str_w0'(_, unify_val(X), Y) :- !, '$create_reg_name'(X, Y).
  2285. '$unify_str_w0'(_, unify_int(X), Y) :- !, '$create_reg_name'(X, Y).
  2286. '$unify_str_w0'(_, unify_con(X), Y) :- !, '$create_reg_name'(X, Y).
  2287. '$unify_str_w0'(_, unify_ground(X), Y) :- !, '$create_reg_name'(X, Y).
  2288.  
  2289. /*---------------------------------------------------------------
  2290.     put$BL?Na$N=PNO(B
  2291. ---------------------------------------------------------------*/
  2292. '$write_cs'(Out, put_var(A)) :- !,
  2293.     '$create_reg_name'(A,  A1),
  2294.     '$writeln_stream'(Out, 8, [A1, ' = engine.makeVariable();']).
  2295.     %'$writeln_stream'(Out, 8, [A1, ' = new VariableTerm();']).
  2296.  
  2297. '$write_cs'(Out, put_list(Car, Cdr, A)) :- !,
  2298.     '$create_reg_name'(A,  A1),
  2299.     '$create_reg_name'(Car, Car1),
  2300.     '$create_reg_name'(Cdr, Cdr1),
  2301.     '$writeln_stream'(Out,
  2302.                    8,
  2303.                [A1, ' = new ListTerm(', Car1, ', ', Cdr1, ');'
  2304.                ]).
  2305.  
  2306. '$write_cs'(Out, put_str(Func, Args, A)) :- !,
  2307.     '$create_reg_name'(A,  A1),
  2308.     '$create_reg_name'(Args, Args1),
  2309.     '$create_reg_name'(Func, Func1),
  2310.     '$writeln_stream'(Out,
  2311.                    8,
  2312.                [A1, ' = new StructureTerm(', Func1, ', ', Args1,  ');'
  2313.                ]).
  2314.  
  2315. '$write_cs'(Out, put_str_args(As, H)) :- !,
  2316.     '$create_reg_name'(H,  H1),
  2317.     '$create_str_args'(As, As1),
  2318.     '$writeln_stream'(Out, 8, ['Term[] ', H1, ' = '|As1]).
  2319.  
  2320. '$write_cs'(Out, put_cont(Pred, P)) :- !,
  2321.     '$create_reg_name'(P, P1),
  2322.     Pred =.. [F|Args0],
  2323.     length(Args0, Arity0),
  2324.     Arity is Arity0 - 1,
  2325.     '$create_qualified_name'(F/Arity, ClassName),
  2326.     '$create_cont_args'(Args0, Args),
  2327.     '$writeln_stream'(Out, 8, [P1, ' = new ', ClassName|Args]).
  2328.  
  2329. '$create_cont_args'(X, Z) :-
  2330.     '$create_reg_args'(X, Y),
  2331.     '$append'(['('|Y], [');'], Z).
  2332.  
  2333. /*---------------------------------------------------------------
  2334.     execute(X)
  2335. ---------------------------------------------------------------*/
  2336. '$write_cs'(Out, execute(P)) :- P == cont, !,  
  2337.     '$writeln_stream'(Out, 8, ['return cont;']).
  2338. '$write_cs'(Out, execute(P)) :- !,
  2339.     P =.. [F|Args],
  2340.     '$write_cs_cont'(Out, F, Args).
  2341.  
  2342. '$write_cs_cont'(Out, F, Args) :- F == '$FCO', !,
  2343.     '$wj_fco_cont'(Out, Args, 1),
  2344.     '$writeln_stream'(Out, 8, ['return engine.GetEntryCode( this ).call( engine );']). % modified JJC
  2345. '$write_cs_cont'(Out, F, Args0) :-
  2346.     length(Args0, Arity0),
  2347.     Arity is Arity0 - 1,
  2348.     '$create_qualified_name'(F/Arity, ClassName),
  2349.     '$create_cont_args'(Args0, Args),
  2350.     '$writeln_stream'(Out, 8, ['return new ', ClassName|Args]).
  2351.  
  2352. '$wj_fco_cont'(Out, [A], _) :- !,
  2353.     '$create_reg_name'(A, A1),
  2354.     '$writeln_stream'(Out, 8, ['engine.cont = ', A1, ';']).
  2355. '$wj_fco_cont'(Out, [A|As], I0) :-
  2356.     '$create_reg_name'(A, A1),
  2357.     '$writeln_stream'(Out, 8, ['engine.aregs[', I0, '] = ', A1, ';']),
  2358.     I is I0+1,
  2359.     '$wj_fco_cont'(Out, As, I).
  2360.  
  2361. /*---------------------------------
  2362.     $B%j%=!<%9(B
  2363. ---------------------------------*/
  2364. '$write_cs'(Out, put_free_vars([], H)) :- !,
  2365.     '$create_reg_name'(H, H1),
  2366.     '$writeln_stream'(Out, 8, ['Term[] ', H1, ' = {};']).
  2367.  
  2368. '$write_cs'(Out, put_free_vars(As, H)) :- !,
  2369.     '$create_reg_name'(H, H1),
  2370.     '$create_str_args'(As, As1),
  2371.     '$writeln_stream'(Out, 8, ['Term[] ', H1, ' = '|As1]).
  2372.  
  2373. '$write_cs'(Out, put_closure(X, Y, R)) :- !,
  2374.     '$create_pred_name'(X, XX),
  2375.     '$create_reg_name'(Y, YY),
  2376.     '$create_reg_name'(R, RR),
  2377.     '$writeln_stream'(Out, 8, [RR, ' = new ClosureTerm( ', XX, ', ', YY, ');']).
  2378.  
  2379. %'$write_cs'(Out, put_closure(X, Y, R)) :- !,
  2380. %   '$create_class_name'(X, XX),
  2381. %   '$create_reg_name'(Y, YY),
  2382. %   '$create_reg_name'(R, RR),
  2383. %   '$writeln_stream'(Out, 8, [RR, ' = new ClosureTerm(new ', XX, '()', ', ', YY, ');']).
  2384.  
  2385. '$write_cs'(Out, look_up_hash(L)) :- !,
  2386.     '$writeln_stream'(Out, 8,  ['if ( !functor.res.isList() )']),
  2387.     (    L == fail ->  '$writeln_stream'(Out, 12, ['return engine.fail();'])
  2388.     ;    '$create_pred_name'(L, LL),
  2389.          '$writeln_stream'(Out, 12, ['return ', LL, ';'])
  2390.     ),
  2391.     '$writeln_stream'(Out, 8,  ['engine.lookUpHash(functor);']).
  2392.  
  2393. '$write_cs'(Out, pickup_resource(_, I, L)) :- !,
  2394.     '$writeln_stream'(Out, 8, ['if ( !engine.pickupResource(functor, ', I, ') )']),
  2395.     (    L == fail ->  '$writeln_stream'(Out, 12, ['return engine.fail();'])
  2396.     ;    '$create_pred_name'(L, LL),
  2397.          '$writeln_stream'(Out, 12, ['return ', LL, ';'])
  2398.     ).
  2399. '$write_cs'(Out, has_more_resource(L)) :- !,
  2400.     '$create_pred_name'(L, P),
  2401.     '$writeln_stream'(Out, 8, ['if ( !engine.hasMoreResource() )']),
  2402.     '$writeln_stream'(Out, 12, ['return ', P, ';']).
  2403. '$write_cs'(Out, restore_resource) :- !,
  2404.     '$writeln_stream'(Out, 8, ['engine.restoreResource();']).
  2405. '$write_cs'(Out, try_resource(L1, L0)) :- !,
  2406.     '$create_pred_name'(L1, P1),
  2407.     '$create_pred_name'(L0, P0),
  2408.     '$writeln_stream'(Out, 8, ['return engine.tryResource(', P1, ', ', P0, ');']).
  2409. '$write_cs'(Out, retry_resource(L1, L0)) :- !,
  2410.     '$create_pred_name'(L1, P1),
  2411.     '$create_pred_name'(L0, P0),
  2412.     '$writeln_stream'(Out, 8, ['return engine.retryResource(', P1, ', ', P0, ');']).
  2413. '$write_cs'(Out, trust_resource(L)) :- !,
  2414.     '$create_pred_name'(L, P),
  2415.     '$writeln_stream'(Out, 8, ['return engine.trustResource(', P, ');']).
  2416. %'$write_cs'(Out, consume(I,J)) :- !,
  2417. %   '$writeln_stream'(Out, 8, ['engine.consume(', I, ', ', J, ');']).
  2418. %'$write_cs'(Out, execute_closure(J)) :- !,
  2419. %   '$writeln_stream'(Out, 8, ['return engine.executeClosure(', J, ');']).
  2420. '$write_cs'(Out, consume_and_exec_closure(I)) :- !,
  2421.     '$writeln_stream'(Out, 8, ['return engine.executeClosure(engine.consume(', I, '));']).
  2422.  
  2423. /*---------------------------------
  2424.     $B$=$NB>(B
  2425. ---------------------------------*/
  2426. '$write_cs'(_, Instruction) :-
  2427.     '$message'([Instruction,is,an,invalid,instruction]),
  2428.     fail.
  2429.  
  2430. /*---------------------------------------------------------------
  2431.     $B%f!<%F%#%j%F%#(B
  2432. ---------------------------------------------------------------*/
  2433. '$member'(X, [X|_]).
  2434. '$member'(X, [_|Ys]) :- '$member'(X, Ys).
  2435.  
  2436. '$writel_stream'(_, []) :- !.
  2437. '$writel_stream'(Out, [X|Xs]) :-
  2438.     write(Out, X),
  2439.     '$writel_stream'(Out, Xs).
  2440.  
  2441. '$writeln_stream'(Out, Tab, Xs) :-
  2442.     tab(Out, Tab),
  2443.     '$writel_stream'(Out, Xs),
  2444.     nl(Out).
  2445.  
  2446. '$change_name'(X, Y) :- X =.. [F0|A], atom(F0), !,
  2447.     name(F0, L0),
  2448.     '$change_name0'(L0, L),
  2449.     name(F, L),
  2450.     Y =.. [F|A].
  2451. '$change_name'(_, _) :-
  2452.     write('Invalid Input!, Can not rename'), nl.
  2453.  
  2454. /* START JJC: idiomatic Prolog names --(one to one)--> idiomatic C# names
  2455.  */
  2456.  
  2457. '$change_name0'( X, Z ) :-
  2458.     X = [Xh|Xt],
  2459.     '$change_start_of_name'( Xh, XhC ),
  2460.     '$change_rest_of_name'( Xt, XtC ),
  2461.         '$append'( XhC, XtC, Z ).
  2462.  
  2463. '$change_start_of_name'( X, [Z] ) :- '$islower'( X ), !, '$toupper'( X, Z ).
  2464. '$change_start_of_name'( X, Z ) :- X = 95, !, Z = "__".
  2465. '$change_start_of_name'( X, Z ) :- '$isdigit'( X ), !, Z = [95, X].
  2466. '$change_start_of_name'( X, Z ) :- '$isupper'( X ), !, Z = [95, X].
  2467. '$change_start_of_name'( X, Z ) :- name( N, [X] ), '$replacement'( N, Z ).
  2468.  
  2469. '$change_rest_of_name'( [], [] ) :- !.
  2470. '$change_rest_of_name'( "_", "_underscore" ) :- !.
  2471. '$change_rest_of_name'( [X|Xs], [X|Ys] ) :- '$islower'( X ), !,
  2472.     '$change_rest_of_name'( Xs, Ys ).
  2473. '$change_rest_of_name'( [X|Xs], [X|Ys] ) :- '$isdigit'( X ), !,
  2474.     '$change_rest_of_name'( Xs, Ys ).
  2475. '$change_rest_of_name'( [X|Xs], [95,X|Ys] ) :- '$isupper'( X ), !,
  2476.     '$change_rest_of_name'( Xs, Ys ).
  2477. '$change_rest_of_name'( [95,X|Xs], [Y|Ys] ) :- '$islower'( X ), !,
  2478.     '$toupper'( X, Y ), '$change_rest_of_name'( Xs, Ys ).
  2479. '$change_rest_of_name'( [95,X|Xs], [95,95,X|Z] ) :- '$isupper'( X ), !,
  2480.     '$change_rest_of_name'( Xs, Z ).
  2481. '$change_rest_of_name'( [95,X|Xs], [95,95,X|Z] ) :- '$isdigit'( X ), !,
  2482.     '$change_rest_of_name'( Xs, Z ).
  2483. '$change_rest_of_name'( [95,X|Xs], [95,95|Z] ) :-
  2484.     name( N, [X] ), '$replacement'( N, Xr ), !, '$append'( Xr, Y, Z ),
  2485.     '$change_rest_of_name'( Xs, Y ).       
  2486. '$change_rest_of_name'( [X|Xs], [95|Z] ) :- name( N, [X] ), '$replacement'( N, Y ), !,
  2487.     '$append'( Y, W, Z ),
  2488.     '$change_rest_of_name'( Xs, W ).
  2489. '$change_rest_of_name'( [95,95|Xs], [95,95|Z] ) :-
  2490.     '$append'( "underscore", W, Z ),
  2491.     '$change_rest_of_name'( Xs, W ).
  2492.  
  2493. '$replacement'( '+', "plus" ).
  2494. '$replacement'( '-', "dash" ).
  2495. '$replacement'( '*', "star" ).
  2496. '$replacement'( '/', "slash" ).
  2497. '$replacement'( '\', "bslash" ).
  2498. '$replacement'( '^', "caret" ).
  2499. '$replacement'( '<', "less" ).
  2500. '$replacement'( '>', "gtr" ).
  2501. '$replacement'( '=', "eq" ).
  2502. '$replacement'( '`', "bquote" ).
  2503. '$replacement'( '~', "tilde" ).
  2504. '$replacement'( ':', "colon" ).
  2505. '$replacement'( '.', "stop" ).
  2506. '$replacement'( '?', "qn" ).
  2507. '$replacement'( '@', "at" ).
  2508. '$replacement'( '#', "hash" ).
  2509. '$replacement'( '&', "amp" ).
  2510. '$replacement'( ';', "scolon" ).
  2511. '$replacement'( '!', "bang" ).
  2512. '$replacement'( ',', "comma" ).
  2513. '$replacement'( '$', "dollar_" ).
  2514.  
  2515. '$islower'( X ) :- "a" =< X, X =< "z".
  2516. '$isupper'( X ) :- "A" =< X, X =< "Z".
  2517. '$isdigit'( X ) :- "0" =< X, X =< "9".
  2518. '$toupper'( X, Z ) :- Z is X - "a" + "A".
  2519.  
  2520. '$constants'(['+','-','*','/','\','^','<','>','=','`',
  2521.        '~',':','.','?','@','#','&',';','!',',']).
  2522.  
  2523. '$create_qualified_name'(FA, S) :- FA = '$res'(F/A, N), !,
  2524.     '$file_name'(File),
  2525.     '$change_name'(F, F1),
  2526.     '$change_name'(File, File1),
  2527. % put in resource just to get it working - structure this better later.
  2528.     '$list_to_string'([ 'Resources.resource_', N, '_', File1, '_', F1, '_', A], S). % removed RES_
  2529.  
  2530. '$create_qualified_name'(FA, S) :-
  2531.     '$create_pred_name'(FA, Pred),
  2532.     '$list_to_string'([ 'Predicates.', Pred], S).
  2533.  
  2534. /* END JJC */
  2535.  
  2536. /* $$B$OH4$$$F$"$k(B */
  2537.  
  2538. /* $B=R8lL>$N:n@.(B $BNc(B) foo/2 --> foo_2 */
  2539. '$create_pred_name'(FA, X) :- atom(FA), !,
  2540.     '$change_name'(FA, FA1),
  2541.     '$list_to_string'([FA1, '_', 0], X).
  2542. /* $B%j%=!<%9$NL>A0(B  */
  2543. '$create_pred_name'(FA, X) :- FA = '$res'(F/A, N), !,
  2544.     '$change_name'(F, F1),
  2545.     '$list_to_string'([F1, '_', A, '_res', N], X).
  2546.  
  2547. %'$create_pred_name'(FA, X) :- FA = '$res'(F/A, N), !,
  2548. %   '$file_name'(File),
  2549. %   '$change_name'(F, F1),
  2550. %   '$list_to_string'(['$res', N, '_', File, '_', F1, '_', A], X).
  2551.  
  2552. '$create_pred_name'(FA, X) :- FA = F/A, !,
  2553.     '$change_name'(F, F1),
  2554.     '$list_to_string'([F1, '_', A], X).
  2555. '$create_pred_name'(FA, X) :- FA = F/A+G/B, !,
  2556.     '$change_name'(F, F1),
  2557.     '$list_to_string'([F1, '_', A, '_', G, '_', B], X).
  2558. '$create_pred_name'(FA, X) :- FA = F/A+N,
  2559.     '$change_name'(F, F1),
  2560.     '$list_to_string'([F1, '_', A, '_', N], X).
  2561.  
  2562. /* START JJC
  2563.  * Most irritatingly Windows' filesystems are not case sensitive,
  2564.  * so we will put a ' before the initial letter if it is lower case,
  2565.  * and a space before a subsequent letter if it is upper case
  2566.  */
  2567.  
  2568. '$create_filename'( X, Z ) :-
  2569.     '$create_class_name'( X, Y ),
  2570.     name( Y, N ),
  2571.     N = [Yh|Yt],
  2572.     '$change_start_of_filename'( Yh, YhC ),
  2573.     '$change_rest_of_filename'( Yt, YtC ),
  2574.     '$append'( YhC, YtC, Zn ),
  2575.     name( Z, Zn ).
  2576.  
  2577. '$change_start_of_filename'( X, Z ) :- '$islower'( X ), !, Z = [39,X].
  2578. '$change_start_of_filename'( X, [X] ).
  2579.  
  2580. '$change_rest_of_filename'( [], [] ) :- !.
  2581. '$change_rest_of_filename'( [X|Xs], [32,X|Ys ] ) :- '$isupper'( X ), !,
  2582.     '$change_rest_of_filename'( Xs, Ys ).
  2583. '$change_rest_of_filename'( [X|Xs], [X|Ys] ) :-
  2584.       '$change_rest_of_filename'( Xs, Ys ).
  2585.  
  2586.  
  2587. /* END JJC */
  2588.  
  2589. /* $B%/%i%9L>$N:n@.(B */
  2590. '$create_class_name'(FA, S) :- FA = '$res'(F/A, N), !,
  2591.     '$file_name'(File),
  2592.     '$change_name'(F, F1),
  2593.     '$change_name'(File, File1),
  2594. % put in resource just to get it working - structure this better later.
  2595.     '$list_to_string'([ 'resource_', N, '_', File1, '_', F1, '_', A], S). % removed RES_
  2596.  
  2597. '$create_class_name'(FA, S) :-
  2598.     '$create_pred_name'(FA, Pred),
  2599.     '$list_to_string'([Pred], S). % removed PRED_
  2600.  
  2601. %'$create_res_class_name'(FA+N, S) :-
  2602. %   '$create_pred_name'(FA, Pred),
  2603. %   '$list_to_string'(['RES_', N, '_', Pred], S).
  2604.  
  2605. /* Register$BL>$N:n@.(B  $BNc(B) a(3) --> a3 */
  2606. '$create_reg_name'(X, _) :- var(X),!,
  2607.     '$message'([invalid,argument,in,create_reg_name/2]), fail.
  2608. '$create_reg_name'(a(N), X) :- !, '$list_to_string'(['a', N], X).
  2609. '$create_reg_name'(s(N), X) :- !, '$list_to_string'(['s', N], X).
  2610. '$create_reg_name'(p(N), X) :- !, '$list_to_string'(['p', N], X).
  2611. '$create_reg_name'(h(N), X) :- !, '$list_to_string'(['h', N], X).
  2612. '$create_reg_name'(f(N), X) :- !, '$list_to_string'(['f', N], X).
  2613. %'$create_reg_name'(void, X) :- !, X = 'new VariableTerm()'.
  2614. '$create_reg_name'(void, X) :- !, X = 'engine.makeVariable()'.
  2615. '$create_reg_name'(cont, X) :- !, X = 'cont'.
  2616. '$create_reg_name'(functor, X) :- !, X = 'functor'.
  2617. '$create_reg_name'(P, P) :-
  2618.     '$message'([invalid,argument,in,create_reg_name/2]), fail.
  2619.  
  2620. /* Prolog$B$N(Batom$B$r(BJava$B$N(BString$B$X(B */
  2621. '$atom_to_string'(PrologAtom, CsAtom) :-
  2622.     name(PrologAtom, Ps),
  2623.     '$add_backslash'(Ps, Js),
  2624.     name(CsAtom, Js).
  2625.  
  2626. '$add_backslash'([], []) :- !.
  2627. '$add_backslash'([P|Ps], [P,P|Js]) :- P =:= "\", !,
  2628.     '$add_backslash'(Ps, Js).
  2629. '$add_backslash'([P|Ps], [Q,P|Js]) :- P =:= """", !,
  2630.     Q is "\",
  2631.     '$add_backslash'(Ps, Js).
  2632. '$add_backslash'([P|Ps], [P|Js]) :-
  2633.     '$add_backslash'(Ps, Js).
  2634.  
  2635. /* $BG[Ns@k8@$N1&B&$N:n@.(B [a(1),a(2)] --> ['{'a1,', ', a2, '};'] */
  2636. '$create_str_args'(X, Z) :-
  2637.     '$create_reg_args'(X, Y),
  2638.     '$append'(['{'|Y], ['};'], Z).
  2639.  
  2640. /* $B%+%s%^$G6h@Z$i$l$?(BRegister$BL>$NNs(B  [a(1),a(2)] --> [a1,',',a2] */
  2641. '$create_reg_args'([X], [Y]) :- !,
  2642.     '$create_reg_name'(X, Y).
  2643. '$create_reg_args'([X|Xs], [Y, ', '|Ys]) :-
  2644.     '$create_reg_name'(X, Y),
  2645.     '$create_reg_args'(Xs, Ys).
  2646.  
  2647. /* $BJXMx(B */
  2648. '$wj_assign_number'(_, N, _, _, _) :- N =< 0, !.
  2649. '$wj_assign_number'(Out, N, Sym, I, End) :- I =:= N, !,
  2650.     '$writel_stream'(Out, [Sym, I, End]).
  2651. '$wj_assign_number'(Out, N, Sym, I, End) :-
  2652.     I < N,
  2653.     J is I+1,
  2654.     '$writel_stream'(Out, [Sym, I, ', ']),
  2655.     '$wj_assign_number'(Out, N, Sym, J, End).
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!