annotate bdditl.pl @ 22:29cf617f49db default tip

newer CVS version
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Fri, 22 Apr 2016 16:47:13 +0900
parents 07d6c4c5654b
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
2
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
1 %
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
2 /*
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
3 Copyright (C) 1991, Shinji Kono, Sony Computer Science Laboratory, Inc.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
4 The University, Newcastle upton Tyne
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
5
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
6 Everyone is permitted to copy and distribute verbatim copies
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
7 of this license, but changing it is not allowed. You can also
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
8 use this wording to make the terms for other programs.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
9
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
10 send your comments to kono@csl.sony.co.jp
22
29cf617f49db newer CVS version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 20
diff changeset
11 $Id: bdditl.pl,v 1.2 2007/08/30 05:16:36 kono Exp $
2
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
12 */
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
13 % ITL subterm standarization with BDT
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
14 %
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
15 % a standard form of ITL, based on subterm classification
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
16 %
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
17 %
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
18
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
19 % :- use_module('~/ITL/tableau/lite').
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
20 :- use_module('~/ITL/bdd/sicstus/bdd').
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
21 % :-op(900,xfy,(&)).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
22
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
23 eitl2bdd(X,Y) :-
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
24 lite:expand(X,X1),itl2bdd(X1,Y).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
25 eb(X,Y) :- ex(X,X1),eitl2bdd(X1,Y).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
26
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
27 subterm_init :-
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
28 (bdd:manager(0);bdd:quit),!,bdd:init,
20
07d6c4c5654b SICStus v4 (ISO prolog syntax)
kono
parents: 2
diff changeset
29 r_abolish(sb,2),
07d6c4c5654b SICStus v4 (ISO prolog syntax)
kono
parents: 2
diff changeset
30 r_abolish(sbn,1),assertz(sbn(2)),
2
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
31 bdd:zero(F),assertz(sb(false,F)), % this is wrong...
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
32 bdd:one(T),assertz(sb(true,T)).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
33
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
34 subterm_check(I,J) :-
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
35 sb(I,Jid),bdd:var_with_id(Jid,J),!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
36 subterm_check(I,N1) :-
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
37 bdd:new_var_first(N1),bdd:if_id(N1,N1id),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
38 retract(sbn(M)),M1 is M+1,asserta(sbn(M1)),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
39 assertz(sb(I,N1id)),!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
40
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
41 % BDD classification of subterm
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
42
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
43 itl2bdd(true,T):-!,bdd:one(T).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
44 itl2bdd(false,F):-!,bdd:zero(F).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
45 itl2bdd(P,F) :- integer(P),!,bdd:unfree(P),P=F. % bdd
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
46 itl2bdd(P,F) :- atom(P),!,subterm_check(P,F).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
47 itl2bdd(?(C,T,F),N) :- !,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
48 itl2bdd(C,C1),itl2bdd(T,T1),itl2bdd(F,F1),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
49 bdd:ite(C1,T1,F1,N),bdd:free(C1),bdd:free(T1),bdd:free(F1).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
50 itl2bdd(not(P),F) :- !,itl2bdd(P,F0),bdd:not(F0,F),bdd:free(F0).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
51 itl2bdd((P,Q),F) :- !,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
52 itl2bdd(P,P0),itl2bdd(Q,Q0),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
53 bdd:and(P0,Q0,F),bdd:free(P0),bdd:free(Q0),!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
54 itl2bdd((P;Q),F) :- !,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
55 itl2bdd(P,P0),itl2bdd(Q,Q0),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
56 bdd:or(P0,Q0,F),bdd:free(P0),bdd:free(Q0),!.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
57 itl2bdd((P&Q), N) :-!,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
58 itl2bdd(P,P1),itl2bdd(Q,Q1),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
59 subterm_check((P1&Q1),N).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
60 itl2bdd(exists(P,Q), N) :-!,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
61 itl2bdd(Q,QF), itl2bdd(P,PF),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
62 subterm_check(exists(PF,QF),N).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
63 itl2bdd(proj(P,Q), N) :-!,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
64 itl2bdd(Q,QF),itl2bdd(P,PF),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
65 subterm_check(proj(PF,QF),N).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
66 itl2bdd(prefix(P), N) :-!,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
67 itl2bdd(P,PF),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
68 subterm_check(prefix(PF),N).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
69 % Simple Functor including Regular variable and state
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
70 itl2bdd(Func,N) :- functor(Func,H,1),!,functor(F0,H,1),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
71 arg(1,Func,A),itl2bdd(A,A0),arg(1,F0,A0),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
72 subterm_check(F0,N).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
73 itl2bdd(Func,N) :- functor(Func,H,2),!,functor(F0,H,2),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
74 arg(1,Func,A),itl2bdd(A,A0),arg(1,F0,A0),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
75 arg(2,Func,B),itl2bdd(B,B0),arg(2,F0,B0),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
76 subterm_check(F0,N).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
77 itl2bdd(Def,true) :-
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
78 write('bdditl error: '),write(Def),nl.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
79
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
80 subterm :-
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
81 listing(sb/2).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
82
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
83 bdd2itl(B,F) :- integer(B),!,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
84 bdd:type(B,I),bdd2itl(I,B,F).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
85 bdd2itl(B,F) :- atom(B),!,F=B.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
86 bdd2itl(B,F) :-
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
87 functor(B,H,N),functor(F,H,N),bdd2itl_subterm(N,N,B,F).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
88
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
89 bdd2itl_subterm(F,B) :- bdd:if_id(B,Bid),sb(F0,Bid),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
90 functor(F0,H,N),functor(F,H,N),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
91 bdd2itl_subterm(N,N,F0,F).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
92 bdd2itl_subterm(0,_,_,_) :- !.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
93 bdd2itl_subterm(N,N1,F,F0) :-
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
94 N0 is N-1,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
95 arg(N,F,A),arg(N,F0,A0),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
96 bdd2itl(A,A0),bdd2itl_subterm(N0,N1,F,F0).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
97
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
98 % BDD Type analysis
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
99 bdd2itl(0,B,OPT) :- !, % nonterminal
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
100 bdd:if(B,IF0),bdd2itl_subterm(IF,IF0),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
101 bdd:then(B,THEN0),bdd2itl(THEN0,THEN),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
102 bdd:else(B,ELSE0),bdd2itl(ELSE0,ELSE),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
103 bdd2itl_opt(IF,THEN,ELSE,OPT).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
104 % little more readable representation
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
105 bdd2itl_opt(IF,true,false,IF) :- !.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
106 bdd2itl_opt(IF,false,true,not(IF)) :- !.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
107 bdd2itl_opt(IF,true,ELSE,(IF;ELSE)) :- !.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
108 bdd2itl_opt(IF,THEN,false,(IF,THEN)) :- !.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
109 bdd2itl_opt(IF,false,ELSE,(not(IF);ELSE)) :- !.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
110 bdd2itl_opt(IF,THEN,true,(not(IF),THEN)) :- !.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
111 bdd2itl_opt(IF,THEN,ELSE,?(IF,THEN,ELSE)) :- !.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
112 bdd2itl(1,_,false) :- !. % zero
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
113 bdd2itl(2,_,true) :- !. % one
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
114 bdd2itl(3,B,F) :- !, % posvar
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
115 bdd2itl_subterm(F,B).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
116 bdd2itl(4,B,not(F)) :- !, % negvar
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
117 bdd:not(B,B1),bdd2itl_subterm(F,B1).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
118 bdd2itl(5,_,overflow) :- !. % overflow
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
119 bdd2itl(6,_,constant) :- !. % constant (mtbdd)
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
120
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
121 % Depth One Expansion
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
122
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
123 bdd2itl1(B,F) :- integer(B),!,
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
124 bdd:type(B,I),bdd2itl1(I,B,F).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
125 bdd2itl1(B,F) :- atom(B),!,F=B.
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
126 bdd2itl1(B,B).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
127
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
128 % BDD Type analysis
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
129 bdd2itl1(0,B,?(IF,THEN,ELSE)) :- !, % nonterminal
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
130 bdd:if_id(B,IF0id),sb(IF,IF0id),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
131 bdd:then(B,THEN),
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
132 bdd:else(B,ELSE). % no use of opt
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
133 bdd2itl1(1,_,false) :- !. % zero
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
134 bdd2itl1(2,_,true) :- !. % one
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
135 bdd2itl1(3,B,F) :- !, % posvar
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
136 bdd:if_id(B,Bid),sb(F,Bid).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
137 bdd2itl1(4,B,not(F)) :- !, % negvar
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
138 bdd:not(B,B1),bdd:if_id(B1,B1id),sb(F,B1id).
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
139 bdd2itl1(5,_,overflow) :- !. % overflow
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
140 bdd2itl1(6,_,constant) :- !. % constant (mtbdd)
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
141
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
142
1c57a78f1d98 Initial revision
kono
parents:
diff changeset
143 % BDD end %