new "code" action

Salvador Abreu
1 parent 2ae2c2a3
Showing 1 changed file with 82 additions and 0 deletions Show diff stats
fz/fzsem.pl
@@ -0,0 +1,82 @@
+% == No, Emacs this is -*-Prolog-*- code, not what you thought... =============
+
+:- initialization(main).
+
+main :-
+    argument_list(A),
+    main(A).
+
+main([ACTION_S|REST]) :- 
+    read_term_from_atom(ACTION_S, ACTION, [end_of_term(eof)]),
+    action(ACTION), !, main(REST).
+main([]).
+
+action(load(F)) :- !, see(F), action(load), seen.
+action(load)    :- !, load_ast(AST), g_assign(ast, AST).
+action(dump(A)) :- !, dump_ast(A).
+action(dump)    :- !, g_read(ast, AST), dump_ast(AST).
+action(name)    :- !, 
+		   g_read(ast, AST), 
+		   sa_names(AST, NAST, ST),
+		   g_assign(ast_n, NAST+ST).
+action(type)    :- !, 
+		   g_read(ast_n, AST+ST), 
+		   sa_types(AST, ST),
+		   g_assign(ast_t, AST+ST).
+action(code)    :- !,
+		   g_read(ast_t, AST+ST),
+		   cg_emit(AST, ST).
+action(halt)    :- !, halt.
+action(debug)   :- g_read(ast_debug, true), !, g_assign(ast_debug, false).
+action(debug)   :- !, g_assign(ast_debug, true).
+action(ACTION)  :- format("%w: unknown action.\n", [ACTION]).
+
+
+% -----------------------------------------------------------------------------
+
+%% beware: fails if load_ast/3 does not finish with 3rd arg singular list
+
+load_ast(AST) :- g_read(ast_debug, true), !, load_ast_deb(_>[], [], [AST]).
+load_ast(AST) :-                             load_ast(_>[], [], [AST]).
+
+load_ast(end_of_file, AST, AST).
+load_ast((IN > INT :- MOD), IN, OUT) :-
+    call(MOD),
+    read(OP), !,
+    load_ast(OP, INT, OUT).
+load_ast((IN > INT), IN, OUT) :-
+    read(OP), !,
+    load_ast(OP, INT, OUT).
+
+load_ast_deb(end_of_file, AST, AST).
+load_ast_deb((IN > INT :- MOD), IN, OUT) :-
+    ( call(MOD) -> format("EXT OK ~q\n", [MOD]) ;
+      format("EXT FAIL ~q\n", [MOD]), fail ),
+    read(OP), !,
+    writeq(IN), write('.'), nl,
+    writeq(OP), nl,
+    load_ast_deb(OP, INT, OUT).
+load_ast_deb(IN > INT,    IN,  OUT) :- 
+    read(OP), !,
+    writeq(IN), write('.'), nl,
+    writeq(OP), nl,
+    load_ast_deb(OP, INT, OUT).
+
+% -----------------------------------------------------------------------------
+
+dump_ast(fzn(PREDS, VARS, CONSTRS, SOLVE)) :- 
+    !,
+    format("AST:\n", []),
+    format("  preds:\n", []), PREDS=preds(PS), dump_list(PS),
+    format("  vars:\n", []),  VARS=vars(VS), dump_list(VS),
+    format("  constrs:\n", []), CONSTRS=constrs(CS), dump_list(CS),
+    format("  goal:\n    ~w\n", [SOLVE]).
+
+dump_ast(AST) :- write(AST), nl.
+
+% -----------------------------------------------------------------------------
+
+dump_list([]).
+dump_list([I|Is]) :- format("    ~w\n", [I]), dump_list(Is).
+
+% -----------------------------------------------------------------------------
...	...	@@ -0,0 +1,82 @@
	1	+% == No, Emacs this is --Prolog-- code, not what you thought... =============
	2	+
	3	+:- initialization(main).
	4	+
	5	+main :-
	6	+ argument_list(A),
	7	+ main(A).
	8	+
	9	+main([ACTION_S\|REST]) :-
	10	+ read_term_from_atom(ACTION_S, ACTION, [end_of_term(eof)]),
	11	+ action(ACTION), !, main(REST).
	12	+main([]).
	13	+
	14	+action(load(F)) :- !, see(F), action(load), seen.
	15	+action(load) :- !, load_ast(AST), g_assign(ast, AST).
	16	+action(dump(A)) :- !, dump_ast(A).
	17	+action(dump) :- !, g_read(ast, AST), dump_ast(AST).
	18	+action(name) :- !,
	19	+ g_read(ast, AST),
	20	+ sa_names(AST, NAST, ST),
	21	+ g_assign(ast_n, NAST+ST).
	22	+action(type) :- !,
	23	+ g_read(ast_n, AST+ST),
	24	+ sa_types(AST, ST),
	25	+ g_assign(ast_t, AST+ST).
	26	+action(code) :- !,
	27	+ g_read(ast_t, AST+ST),
	28	+ cg_emit(AST, ST).
	29	+action(halt) :- !, halt.
	30	+action(debug) :- g_read(ast_debug, true), !, g_assign(ast_debug, false).
	31	+action(debug) :- !, g_assign(ast_debug, true).
	32	+action(ACTION) :- format("%w: unknown action.\n", [ACTION]).
	33	+
	34	+
	35	+% -----------------------------------------------------------------------------
	36	+
	37	+%% beware: fails if load_ast/3 does not finish with 3rd arg singular list
	38	+
	39	+load_ast(AST) :- g_read(ast_debug, true), !, load_ast_deb(_>[], [], [AST]).
	40	+load_ast(AST) :- load_ast(_>[], [], [AST]).
	41	+
	42	+load_ast(end_of_file, AST, AST).
	43	+load_ast((IN > INT :- MOD), IN, OUT) :-
	44	+ call(MOD),
	45	+ read(OP), !,
	46	+ load_ast(OP, INT, OUT).
	47	+load_ast((IN > INT), IN, OUT) :-
	48	+ read(OP), !,
	49	+ load_ast(OP, INT, OUT).
	50	+
	51	+load_ast_deb(end_of_file, AST, AST).
	52	+load_ast_deb((IN > INT :- MOD), IN, OUT) :-
	53	+ ( call(MOD) -> format("EXT OK ~q\n", [MOD]) ;
	54	+ format("EXT FAIL ~q\n", [MOD]), fail ),
	55	+ read(OP), !,
	56	+ writeq(IN), write('.'), nl,
	57	+ writeq(OP), nl,
	58	+ load_ast_deb(OP, INT, OUT).
	59	+load_ast_deb(IN > INT, IN, OUT) :-
	60	+ read(OP), !,
	61	+ writeq(IN), write('.'), nl,
	62	+ writeq(OP), nl,
	63	+ load_ast_deb(OP, INT, OUT).
	64	+
	65	+% -----------------------------------------------------------------------------
	66	+
	67	+dump_ast(fzn(PREDS, VARS, CONSTRS, SOLVE)) :-
	68	+ !,
	69	+ format("AST:\n", []),
	70	+ format(" preds:\n", []), PREDS=preds(PS), dump_list(PS),
	71	+ format(" vars:\n", []), VARS=vars(VS), dump_list(VS),
	72	+ format(" constrs:\n", []), CONSTRS=constrs(CS), dump_list(CS),
	73	+ format(" goal:\n ~w\n", [SOLVE]).
	74	+
	75	+dump_ast(AST) :- write(AST), nl.
	76	+
	77	+% -----------------------------------------------------------------------------
	78	+
	79	+dump_list([]).
	80	+dump_list([I\|Is]) :- format(" ~w\n", [I]), dump_list(Is).
	81	+
	82	+% -----------------------------------------------------------------------------
...	...