changeset 20:07d6c4c5654b iso-prolog

SICStus v4 (ISO prolog syntax)
author kono
date Thu, 30 Aug 2007 14:16:36 +0900
parents e1d3145cff7a
children 8fb7b6f55b7e
files Makefile bddcomp.pl bdditl.pl bdtstd.pl chop.pl cp.pl cppl.c diag.pl disp.pl dvcomp.pl exdev.pl itl.pl itlstd.pl kiss.pl ndcomp.pl op.pl rstd.pl
diffstat 17 files changed, 64 insertions(+), 47 deletions(-) [+]
line wrap: on
line diff
--- a/Makefile	Thu Aug 30 12:44:35 2007 +0900
+++ b/Makefile	Thu Aug 30 14:16:36 2007 +0900
@@ -9,7 +9,7 @@
 # send your comments to kono@csl.sony.co.jp
 
 PROLOG = sicstus
-PROLOG_TYPE = SICSTUS
+PROLOG_TYPE = SICSTUSV4
 
 # PROLOG = sbprolog
 # PROLOG_TYPE = SBPROLOG
--- a/bddcomp.pl	Thu Aug 30 12:44:35 2007 +0900
+++ b/bddcomp.pl	Thu Aug 30 14:16:36 2007 +0900
@@ -260,17 +260,17 @@
 
 init :-
 	subterm_init,
-	abolish(state,3),
+	r_abolish(state,3),
 	asserta((state(true,[more],true):-!)),
 	asserta((state(true,[empty],0):-!)),
 	(lazy,assertz((state(A,B,C) :- lazy_state(A,B,C))),!;true),
-        abolish(itl_state,2),
-        abolish(stay,3),asserta(stay(0,0,0)),
+        r_abolish(itl_state,2),
+        r_abolish(stay,3),asserta(stay(0,0,0)),
 	bdd:zero(F), bdd:one(T),
         asserta(itl_state(F,false)),
         asserta(itl_state(empty,0)),
         asserta(itl_state(T,true)),
-	abolish(links,2),asserta(links(true,true)),
+	r_abolish(links,2),asserta(links(true,true)),
 	init_var(itl_state_number,1),!.
 
 show_state(S,ITL) :-
--- a/bdditl.pl	Thu Aug 30 12:44:35 2007 +0900
+++ b/bdditl.pl	Thu Aug 30 14:16:36 2007 +0900
@@ -26,8 +26,8 @@
 
 subterm_init :- 
 	(bdd:manager(0);bdd:quit),!,bdd:init,
-	abolish(sb,2),
-	abolish(sbn,1),assertz(sbn(2)),
+	r_abolish(sb,2),
+	r_abolish(sbn,1),assertz(sbn(2)),
 	bdd:zero(F),assertz(sb(false,F)), % this is wrong...
 	bdd:one(T),assertz(sb(true,T)).
 
--- a/bdtstd.pl	Thu Aug 30 12:44:35 2007 +0900
+++ b/bdtstd.pl	Thu Aug 30 14:16:36 2007 +0900
@@ -18,9 +18,9 @@
 %
 %
 subterm_init :- 
-	abolish(sb,2),
+	r_abolish(sb,2),
 	asserta((sb([],-1))),
-	abolish(sbn,1),
+	r_abolish(sbn,1),
 	asserta(sbn(0)).
 
 std_check(I,J) :-
--- a/chop.pl	Thu Aug 30 12:44:35 2007 +0900
+++ b/chop.pl	Thu Aug 30 14:16:36 2007 +0900
@@ -128,7 +128,7 @@
 check_atomic(P) :- name(P,PL),PL=[95|_],!.
 check_atomic(P) :- add_variable(P). % "_"
 
-% do not use abolish here to avoid erase dynamic property of variable/1
+% do not use r_abolish here to avoid erase dynamic property of variable/1
 init_variable :- retract(variable(_)),fail;true.
 add_variable([]):-!.
 add_variable([X|T]) :- !,add_variable(X),add_variable(T).
--- a/cp.pl	Thu Aug 30 12:44:35 2007 +0900
+++ b/cp.pl	Thu Aug 30 14:16:36 2007 +0900
@@ -1,5 +1,6 @@
-A '\=' A :-!,fail.
-_ '\=' _.
 r_cputime(X) :- statistics(runtime,[X1,_]),X is X1/1000.
-append([],X,X).
-append([H|X],Y,[H|Z]) :- append(X,Y,Z).
+r_abolish(A,B) :- abolish(A/B).
+
+put(C) :- char_code(Char,C),put_char(Char).
+
+ttyflush :- flush_output.
--- a/cppl.c	Thu Aug 30 12:44:35 2007 +0900
+++ b/cppl.c	Thu Aug 30 14:16:36 2007 +0900
@@ -34,7 +34,7 @@
 
 #endif
 
-#if ! defined(XSB)
+#if ! defined(XSB) && ! defined(SICSTUSV4)
 A '\=' A :-!,fail.
 _ '\=' _.
 #endif
@@ -57,6 +57,9 @@
 #endif
 
 #endif
+#if defined(SICSTUSV4) 
+r_cputime(X) :- statistics(runtime,[X1,_]),X is X1/1000.
+#endif
 
 #if defined(CPROLOG) 
 
@@ -69,8 +72,24 @@
 :- (ttyflush;assert((ttyflush))).
 #endif
 
+#if !defined(SICSTUSV4)
 append([],X,X).
 append([H|X],Y,[H|Z]) :- append(X,Y,Z).
 
+member(H,[H|_]).
+member(H,[_|T]):-member(H,T).
+
+#endif
+
+#if !defined(SICSTUSV4)
+r_abolish(A,B) :- abolish(A,B).
+#else
+r_abolish(A,B) :- abolish(A/B).
+
+put(C) :- char_code(Char,C),put_char(Char).
+
+ttyflush :- flush_output.
+
+#endif
 
 /* end  */
--- a/diag.pl	Thu Aug 30 12:44:35 2007 +0900
+++ b/diag.pl	Thu Aug 30 14:16:36 2007 +0900
@@ -164,9 +164,6 @@
 rev([],X,X).
 rev([H|T],X,Y) :- rev(T,[H|X],Y).
 
-member(H,[H|_]).
-member(H,[_|T]):-member(H,T).
-
 not_member(_,[]):-!.
 not_member(H,[H|_]):-!,fail.
 not_member(H,[_|T]):-not_member(H,T).
--- a/disp.pl	Thu Aug 30 12:44:35 2007 +0900
+++ b/disp.pl	Thu Aug 30 14:16:36 2007 +0900
@@ -11,7 +11,7 @@
 
 :- dynamic r_event/2.
 
-:- abolish(show_state,2).
+:- r_abolish(show_state,2).
 % Next command keep check event during verification
 show_state(S,ITL) :-!,
         (tcl_eval(update);true),!,
@@ -90,7 +90,7 @@
 
 verify(X) :-
         all_disable,
-	abolish(st,3),abolish(specification,1),abolish(st_variables,2),
+	r_abolish(st,3),r_abolish(specification,1),r_abolish(st_variables,2),
 	t2string(X,X0),s2terms(X0,X1),command(X1,X2,X3),
 	display_contents(X3),
 	ex(X2),!,
--- a/dvcomp.pl	Thu Aug 30 12:44:35 2007 +0900
+++ b/dvcomp.pl	Thu Aug 30 14:16:36 2007 +0900
@@ -334,12 +334,12 @@
 
 init :-
 	subterm_init,
-        abolish(itl_state,2),
-        abolish(stay,3),asserta(stay(0,0,0)),
+        r_abolish(itl_state,2),
+        r_abolish(stay,3),asserta(stay(0,0,0)),
         asserta(itl_state(false,false)),
         asserta(itl_state(empty,0)),
         asserta(itl_state(true,true)),
-	abolish(links,2),asserta(links(true,true)),
+	r_abolish(links,2),asserta(links(true,true)),
         init_var(current,0),
         init_var(over,0),
         init_var(itl_transition,0),
@@ -360,7 +360,7 @@
 	inc_var(itl_state_number,S),
 	assert(itl_state(STD,S)),!.
 
-init_var(X,V) :- abolish(X,1),functor(F,X,1),arg(1,F,V),assert(F),!.
+init_var(X,V) :- r_abolish(X,1),functor(F,X,1),arg(1,F,V),assert(F),!.
 inc_var(Name,X1) :- 
         functor(F,Name,1),retract(F),arg(1,F,X),
         X1 is X+1,functor(F1,Name,1),arg(1,F1,X1),
--- a/exdev.pl	Thu Aug 30 12:44:35 2007 +0900
+++ b/exdev.pl	Thu Aug 30 14:16:36 2007 +0900
@@ -78,15 +78,15 @@
 
 init :-
 	subterm_init,
-	abolish(state,3),
+	r_abolish(state,3),
 	asserta(state(true,[more],true)),
 	asserta(state(true,[empty],0)),
-        abolish(itl_state,2),
-        abolish(stay,3),asserta(stay(0,0,0)),
+        r_abolish(itl_state,2),
+        r_abolish(stay,3),asserta(stay(0,0,0)),
         asserta(itl_state(false,false)),
         asserta(itl_state(empty,0)),
         asserta(itl_state(true,true)),
-	abolish(links,2),asserta(links(true,true)),
+	r_abolish(links,2),asserta(links(true,true)),
 	init_var(itl_transition,1),
 	init_var(itl_state_number,1),!.
 
--- a/itl.pl	Thu Aug 30 12:44:35 2007 +0900
+++ b/itl.pl	Thu Aug 30 14:16:36 2007 +0900
@@ -15,8 +15,8 @@
 	true(C,A,C,C1),!,
 
 	itl_false(C,A,F,X0,X1).
-itl_true(C,A,T,X,X) :-
-itl_true(_,_,X,X) :-
+itl_true(C,A,T,X,X) :-true.
+itl_true(_,_,X,X) :-true.
 
 true([],A,C,[A|C]):-!.
 true([A|_],A,C,C):-!.
--- a/itlstd.pl	Thu Aug 30 12:44:35 2007 +0900
+++ b/itlstd.pl	Thu Aug 30 14:16:36 2007 +0900
@@ -23,13 +23,13 @@
 %		more,Pn,(Px & Q)
 %
 subterm_init :- 
-	abolish(sb,3),
+	r_abolish(sb,3),
 	asserta((sb(-1,[],[]))),
-	abolish(sbn,1),
+	r_abolish(sbn,1),
 	asserta(sbn(0)),
-        abolish(itl_state,2),
-        assertz(itl_state(([[]->false]),false)),
-        assertz(itl_state(([[]->true]),0)),!.
+        r_abolish(itl_state,2),
+        assertz(itl_state((['->'([],false)]),false)),
+        assertz(itl_state((['->'([],true)]),0)),!.
 
 
 std_check(I,J,N) :-
@@ -41,7 +41,7 @@
 itlstd(P,List) :- 
 	setof(N,subterm(P,N),List),!.
 
-subterm(P,C->T) :-
+subterm(P,'->'(C,T)) :-
 	subterm(P,T,[],C0),
 	sortC(C0,C).
 	
--- a/kiss.pl	Thu Aug 30 12:44:35 2007 +0900
+++ b/kiss.pl	Thu Aug 30 14:16:36 2007 +0900
@@ -12,7 +12,7 @@
 
 % :- dynamic st_variables/2.
 
-set_input_var(L) :- abolish(input_variable_list,1),
+set_input_var(L) :- r_abolish(input_variable_list,1),
 	asserta(input_variable_list(L)).
 
 kiss :-
@@ -178,8 +178,8 @@
 	read_kiss_body(C1,In,Out,Emode).
 
 init_read_kiss(In,Out,IL,OL) :-
-	abolish(st_variables,2),
-	abolish(st,3),
+	r_abolish(st_variables,2),
+	r_abolish(st,3),
 	assert(st_variables(In,Out)),
 	assert(st(true,true,true)),
 	length(In,IL),length(Out,OL).
@@ -264,7 +264,7 @@
 read_kiss_state1(C,C1,[]) :-
 	skip_space(C,C1),!.
 
-skip_space(C,C1):- ([C]=" ";[C]="	"),!,
+skip_space(C,C1):- ([C]=[32];[C]=[9]),!,
 	get(C0),skip_space(C0,C1).
 skip_space(C,C).
 
--- a/ndcomp.pl	Thu Aug 30 12:44:35 2007 +0900
+++ b/ndcomp.pl	Thu Aug 30 14:16:36 2007 +0900
@@ -271,16 +271,16 @@
 
 init :-
 	subterm_init,
-	abolish(state,3),
+	r_abolish(state,3),
 	asserta(state(true,[more],true)),
 	asserta(state(true,[empty],0)),
-        abolish(itl_state,2),
-        abolish(stay,3),asserta(stay(0,0,0)),
+        r_abolish(itl_state,2),
+        r_abolish(stay,3),asserta(stay(0,0,0)),
         asserta(itl_state(false,false)),
         asserta(itl_state(empty,0)),
         asserta(itl_state(true,true)),
         init_var(regular_limit,5),
-	abolish(links,2),asserta(links(true,true)),
+	r_abolish(links,2),asserta(links(true,true)),
 	init_var(current,0),
 	init_var(itl_transition,1),
 	init_var(itl_state_number,1),!.
--- a/op.pl	Thu Aug 30 12:44:35 2007 +0900
+++ b/op.pl	Thu Aug 30 14:16:36 2007 +0900
@@ -1,5 +1,5 @@
 :-op(900,xfy,[(&),('&&')]).
-:-op(600,xfy,['<->','\=',proj]).
+:-op(600,xfy,['<->','\\=',proj]).
 :-op(600,xfy,['=>','<=']).
 :-op(60,fy,['~','#','<>', '@',^]).
 :-op(60,fy,[*]).
--- a/rstd.pl	Thu Aug 30 12:44:35 2007 +0900
+++ b/rstd.pl	Thu Aug 30 14:16:36 2007 +0900
@@ -19,9 +19,9 @@
 :- dynamic sb/2,sbn/1.
 
 subterm_init :- 
-	abolish(sb,2),
+	r_abolish(sb,2),
 	asserta((sb([],-1))),
-	abolish(sbn,1),
+	r_abolish(sbn,1),
 	asserta(sbn(0)).
 
 std_check([],I,?(I1,true,false)) :-!,   % no regular variable