home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 01 / pattern / bp6.pro < prev    next >
Encoding:
Text File  |  1987-06-05  |  4.7 KB  |  181 lines
  1. /***********************************************
  2.    Programm BP6: Validierung propositionaler
  3.                   Formeln
  4. ************************************************/  
  5.  
  6. include "MATCH.1"
  7. include "MATCH.2"
  8.  
  9. predicates
  10.   pattern(symbol, patternlist)
  11.   main
  12.   retractprops
  13.   wang
  14.   solve(symbol, stringlist)
  15.   put(stringlist, stringlist)
  16.   efface(string, stringlist, stringlist)
  17.   treat(string, symbol, string, string, string)
  18.   repeat
  19.   listdb
  20.   test(stringlist, stringlist)
  21.   check(string)
  22.  
  23. goal 
  24.   main.  
  25.  
  26. include "MATCH.3" 
  27.  
  28. clauses
  29.   pattern(w, [break(["imp", "and", "or"])]).
  30.   pattern(binop, [any(["imp", "and", "or"])]).
  31.   pattern(formula, [W, BINOP, lit("("), bal, lit(","),
  32.      bal, lit(")"), rpos(0)] ):-
  33.      pattern(w, [W]), pattern(binop, [BINOP]).
  34.   pattern(formula, [break(["not"]), lit("not"), 
  35.      lit("("), bal, lit(")"), null, null, rpos(0) ]).
  36.   
  37.   
  38.   main:-
  39.     makewindow(1,7,7,"Logic Analyzer",0,0,25,80),
  40.     repeat,
  41.     clearwindow,
  42.     write("Formula:"), nl,
  43.     readln(Input), nl,
  44.     retractprops,
  45.     assertz(prop([], [])),
  46.     trim(Input, Form),
  47.     check(Form),
  48.     put([], [Form]),
  49.     wang, fail.
  50.   
  51.   check(Form) :-
  52.     match(Form, [bal, rpos(0)], _), !.
  53.   check(_):- nl, nl,
  54.     write("*** THIS IS NOT A BALANCED EXPRESSION ***"),
  55.     readchar(_), fail.
  56.     
  57.  
  58.   retractprops :-
  59.     retract(prop(_, _)),  fail.
  60.   retractprops.
  61.  
  62.   put(SL1, SL2) :-
  63.     retract(prop(_, _)),
  64.     assertz(prop(SL1, SL2)),
  65.     write(SL1, " ", '\205','\205','\16', " ", SL2),
  66.     nl, nl,
  67.     readchar(_).
  68.     
  69.    wang:- not(prop(_, _)), 
  70.      write("valid"), nl, 
  71.      readchar(_), !.
  72.    wang:-
  73.      prop(Ante, _), 
  74.      solve(ante, Ante), !, wang.
  75.    wang:-
  76.      prop(_, Conseq), 
  77.      solve(conseq, Conseq), !,
  78.      wang.
  79.    wang:-
  80.      prop(A, B), 
  81.      test(A, B), !,  wang.
  82.    wang:-!, write("not valid"), nl,
  83.      readchar(_), retractprops, fail.
  84.      
  85.    test([], _):- !, fail.
  86.    test(_, []):- !, fail.          
  87.    test([H| _], B) :-
  88.      member(H, B), !,
  89.      /*write(" OK"), nl,
  90.      listdb,*/
  91.      retract(prop(_, _)).
  92.    test([_| Tail], B):- !, test(Tail, B).
  93.    test(_, _):- !, write("not valid"), nl,
  94.      readchar(_).
  95.  
  96.    solve(ante, [H| _]) :-
  97.      pattern(formula, Pattern),
  98.      match(H, Pattern, [_, Op, _, Phi, _, Psi, _,_]),
  99.      treat(H, ante, Op, Phi, Psi), !.
  100.    solve(ante, [_| Tail]) :- 
  101.      solve(ante, Tail).
  102.    solve(conseq, [H| _]) :-
  103.      pattern(formula, Pattern),
  104.      match(H, Pattern, [_, Op, _, Phi, _, Psi, _,_]),   
  105.      treat(H, conseq, Op, Phi, Psi), !.
  106.    solve(conseq, [_| Tail]) :- 
  107.      solve(conseq, Tail).
  108.  
  109.   treat(Str, ante, "and", Phi, Psi) :-
  110.     prop(Ante, Conseq),
  111.     efface(Str, Ante, Ante1),
  112.     append(Ante1, [Phi], Ante2),
  113.     append(Ante2, [Psi], Ante3),
  114.     put(Ante3, Conseq).
  115.   treat(Str, ante, "or", Phi, Psi):-
  116.     prop(Ante, Conseq),
  117.     efface(Str, Ante, Ante1),
  118.     append(Ante1, [Phi], Ante2),
  119.     put(Ante2, Conseq),
  120.     append(Ante1, [Psi], Ante3),
  121.     assertz(prop(Ante3, Conseq)),
  122.     write(Ante3, " ", '\205','\205','\16', " ", Conseq), 
  123.     nl, nl,
  124.     readchar(_).
  125.   treat(Str, ante, "imp", Phi, Psi):-
  126.     prop(Ante, Conseq),
  127.     efface(Str, Ante, Ante1),
  128.     append(Ante1, [Psi], Ante2),
  129.     put(Ante2, Conseq),
  130.     append(Conseq, [Phi], Conseq1),
  131.     assertz(prop(Ante1, Conseq1)),
  132.     write(Ante1, " ", '\205','\205','\16', " ", Conseq1), 
  133.     nl, nl,
  134.     readchar(_).
  135.   treat(Str, ante, "not", Phi, _) :-
  136.     prop(Ante, Conseq),
  137.     efface(Str, Ante, Ante1),
  138.     append(Conseq, [Phi], Conseq1),
  139.     put(Ante1, Conseq1).
  140.     
  141.   treat(Str, conseq, "and", Phi, Psi) :-
  142.     prop(Ante, Conseq),
  143.     efface(Str, Conseq, Conseq1),
  144.     append(Conseq1, [Psi], Conseq2),
  145.     put(Ante, Conseq2),
  146.     append(Conseq1, [Phi], Conseq3),
  147.     assertz(prop(Ante, Conseq3)),
  148.     write(Ante, " ", '\205','\205','\16', " ", Conseq3), 
  149.     nl, nl,
  150.     readchar(_).
  151.   treat(Str, conseq, "or", Phi, Psi) :-
  152.     prop(Ante, Conseq),
  153.     efface(Str, Conseq, Conseq1),
  154.     append(Conseq1, [Phi], Conseq2),
  155.     append(Conseq2, [Psi], Conseq3),
  156.     put(Ante, Conseq3).
  157.   treat(Str, conseq, "imp", Phi, Psi) :-
  158.     prop(Ante, Conseq),
  159.     efface(Str, Conseq, Conseq1),
  160.     append(Ante, [Phi], Ante1),
  161.     append(Conseq1, [Psi], Conseq2),
  162.     put(Ante1, Conseq2).  
  163.   treat(Str, conseq, "not", Phi, _) :-
  164.     prop(Ante, Conseq),
  165.     efface(Str, Conseq, Conseq1),
  166.     append(Ante, [Phi], Ante1),
  167.     put(Ante1, Conseq1).
  168.    
  169.   repeat.
  170.   repeat:- repeat.
  171.   
  172.   efface(A, [A| L], L) :- !.
  173.   efface(A, [B| L], [B| M]) :- efface(A, L, M).
  174.     
  175.   listdb :-
  176.     prop(A, B),
  177.     write("DB=", A, " -> ", B), nl,
  178.     fail.
  179.   listdb:- write("DB= "), readchar(_), nl.
  180. /**************** Ende BP6 *********************/
  181.