Corso di Fondamenti di informatica II 
	
PROGETTO 1 : " MINI-PROLOG IN SML "
a cura di Gianluca Di Tomassi

 

Questo e' stato uno dei due progetti da me curati per il corso di Fondamenti di Informatica 
II svolto nell'anno accademico 1995/96, di seguito viene riportato il codice :

 

(*  ------------------------------------------------------------- *)
(*  Costruzione di un MINI-PROLOG in sml, elaborato e realizzato  *)
(*  da DI TOMASSI GIANLUCA ingegneria informatica , matricola N.  *)
(*  080100021                                                     *)
(*  ------------------------------------------------------------- *)


(* Definizione del datatype su qui costruire le regole,i fatti e *)
(* le query.                                                     *)

datatype arg = Var of string
              |Const of string;

datatype expr = Pred of (string*arg list); 

datatype clausola = Cla of (expr list);
    
type programma = clausola list;    
                    
datatype domande = Que of expr;
		
datatype environment = Env of (arg*arg) list;
                      
datatype 'a possible = Fail | OK of 'a ;


(* Introduzione ,secondo il datatype sopra definito, del database di un  *)
(* programma prolog costituito da una regola e da una serie di fatti che *)
(* sono i seguenti :                                                     *)
(* REGOLA: sorella(x,y):- femmina(x) , genitori(x,f,m) , genitori(y,f,m) *)
(* FATTI :   femmina(giorgia)                                            *)
(*           femmina(silvia)                                             *)
(*           genitori(giorgia,luigia,claudio)                            *)
(*           genitori(silvia,ines,claudio)                               *) 
(*           genitori(marco,ines,claudio)                                *)


val progr =[Cla ( [Pred ("sorella",[Var "X",Var "Y"]),
             Pred ("femmina",[Var "X"]) ,
             Pred ("genitori",[Var "X",Var "F",Var "M"]),
             Pred ("genitori",[Var "Y",Var "F",Var "M"])] ),
    Cla [Pred ("femmina",[Const "giorgia"])],
    Cla [Pred ("femmina",[Const "silvia"])],
    Cla [Pred ("genitori",[Const "giorgia",Const "luigia",Const "claudio"])],
    Cla [Pred ("genitori",[Const "silvia",Const "ines",Const "claudio"])],
    Cla [Pred ("genitori",[Const "marco",Const "ines",Const "claudio"])];
    


exception Ex of string;
fun error s=raise Ex s;


(* La variabile contatore,viene inizializzata ad un indirizzo di *)
(* memoria.                                                      *)

val contatore=ref 0;


(* nuovonome : unit --> string.     Funzione che permette utiliz *)
(* zando i "puntatori" di rinominare le variabili che compaiono  *)
(* come argomenti di clausole. Le variabili vengono rinominate   *)
(* utilizzando un nome fittizio XxXx (che si ipotizza non essere *)
(* il nome di nessuna variabile), la prima variabile verra' rino *)
(* minata con XxXx1, la seconda con XxXx2, la terza con XxXx3 e  *)
(* cosi' via.                                                    *)

fun nuovonome ()  = (contatore:=(!contatore+1);
                     implode["XxXx",makestring(!contatore)]);
    



(* rinomina_var : (arg list) --> (arg list).                     *)
(* Funzione che data in ingresso una lista di argomenti se un    *)
(* argomento e' una variabile allora viene rinominata tramite la *)
(* funzione nuovonome altrimenti se e' una costante non viene    *)
(* rinominata.                                                   *) 

fun rinomina_var [] = []
   |rinomina_var ((Var x)::rest) =
        (Var (nuovonome ()))::(rinomina_var rest)
   |rinomina_var ((Const x)::rest) =
        (Const x)::(rinomina_var rest);
   



(* rinomina_clausola : (expr list) --> (expr list)               *)
(* Funzione che permette data una lista di clausole , di rinomina*)
(* re tutte le variabili che compaiono al suo interno.           *)

fun rinomina_clausola [] = []
   |rinomina_clausola (Pred (pred,arg)::rest) =
             (Pred (pred,rinomina_var arg)::rinomina_clausola rest)



(* isvar : arg --> bool.        Funzione che restituisce true se *)
(* se l'argomento dato in input e' una variabile e false altrimen*)
(* ti.                                                           *)

fun isvar (Var x) =true
   |isvar (_) = false;


(* legato : environment --> arg --> bool.      Funzione che dato *)
(* l' ambiente e un argomento in ingresso permette di verificare *)
(* se tale argomento e' gia' presente nell' ambiente.            *)
         
fun legato (Env []) (x:arg) = false
   |legato (Env ((a,b)::L)) x = 
            if ((a=x) orelse (b=x)) 
              then true
	          else legato (Env L) x;
				       


(* altri : environment --> arg --> arg.        Funzione che dati *)
(* in input l'ambiente e un argomento, effettua due controlli :  *)
(* 1) se il primo argomento della coppia nell' ambiente e' uguale*)
(*    all' argomento dato in input allora restituisce il secondo *)
(*    elemento della coppia                                      *) 
(* 2) se il secondo argomento della coppia nell' ambiente e' ugua*)
(*    le all' argomento dato in input allora restituisce il primo*)
(*    elemento della coppia                                      *)
 
fun altri (Env((a,b)::ambrest)) (x:arg) =
          if a=x 
            then b
	       else if b=x 
                      then a
	                  else altri (Env(ambrest)) x;


(* cercaarg : environment --> arg --> arg possible               *)
(* Funzione che dati in input l'ambiente e una variabile, prende *)
(* l'argomento a cui e' legata tale variabile e se l' argomento  *)
(* e' una variabile allora si ha Fail altrimenti restituisce     *)
(* l'argomento.                                                  *)

fun cercaarg env (Var x) = 
let
   val argo = altri env (Var x)
in
  if (isvar(argo)) 
    then Fail
       else OK (argo)
 end;
    


(* trovaarg : environment --> arg --> arg possible               *)
(* Funzione che prende in input l'ambiente e una variabile, e se *)
(* tale variabile e' legata nell'ambiente cerca l'argomento a cui*)
(* e' legata, altrimenti se non e' legata restituisce Fail       *)

fun trovaarg env (Var x) = 
          if (legato env (Var x)) 
	    then cercaarg env (Var x)
	      else Fail

    



(* cerca : environment --> arg --> arg.                          *)
(* Funzione che dati in input l'ambiente e una variabile x, se   *)
(* l'argomento a cui e' legata la variabile e' lui stesso una    *)
(* variabile allora la funzione si richiama ricorsivamente pren  *)
(* dendo in ingresso l'ambiente e come variabile si cercano altri*)
(* argomenti legati ad x, altrimenti se l'argomento a cui e' lega*)
(* ta la variabile e' una costante, allora si cerca quale e' tale*)
(* costante.                                                     *)
  
fun cerca env (Var x) = 
let
   val altro = altri env (Var x)
in
  if (cercaarg env (Var x) = Fail)
   then cerca env (altro)
      else altro 
end;


(* trasforma : 'a list --> 'a list        *)			      

fun trasforma nil = nil;
    trasforma (Ok a) = a



(* trasforma1 : clausola --> (expr list)  *)

fun trasforma1 nil = nil;
    trasforma1 (Cla L) = L
   


(* unify : (arg list) --> (arg list) --> 'a possible.            *)
(* Funzione che permette di effettuare l' unificazione           *)

fun unify [] [] env = (OK env)
   |unify ((Const a)::L) ((Const b)::Q) env = 
            if (a=b) 
               then (unify L Q env) 
                    else Fail
   
   |unify (Var a) (Var b) env = 
	      if (legato env (Var a)) 
	        then
		     if ((trovaarg env (Var a)) <> Fail) 
			then unify (cerca env (Var a)) (Var b) env
			  else ( OK (Env ((a,b)::env)) )
	              else ( OK ((a,b)::env) )     

   |unify ((Var a)::L) ((Const b)::Q) env = 
      let
        val app = (trovaarg env (Var a))	  
      in
         if (app = Fail)
	   then ( unify L Q (Env ((a,b)::env)) )
  	       else if ( (trasforma(app)) = b)
                      then (OK env)
                          else Fail
      end
   
   |unify ((Const b)::Q) ((Var a)::L) env = 
                  unify ((Var a)::L) ((Const b)::Q) env;
   





(* mprolog : programma --> (domande list) --> arg --> environment *)
(*           'a possible.                                         *)
(* risposta : programma --> (domande list) --> arg --> environment*)
(*            'a possible.                                        *)

fun mprolog  [] _  env =  error" Non c'e' il programma "
   |mprolog  (( Cla ( Pred (pred,arg)::L )::rest ):programma) 
                ( (Pred (pred1,arg1)::rest1)::domande list) env =

     let       
        val ( Pred (pred,arg)::L ) = rinomina_clausola ( Pred (pred,arg)::L )   
     in

     if  ( (pred=pred1) andalso (length(arg)=length(arg1)) ) =
    	then 
	 risposta  ( (Pred (pred,arg))::L ) =  
                     ( (Pred (pred1,arg1))::rest1 ) env
     	   else
	     mprolog  rest (Pred (pred1,arg1)::rest1) env

     end

and risposta  _ [] env = (Ok enva)
   |risposta (Cla ( Pred ((pred,arg)::L)::rest )) 
             ((Pred (pred1,arg1))::rest1)  env =

    let
      val unifica = unify arg arg1 env
    in      

      if (unifica = Fail) 
	 then
	   mprolog rest ( (Pred (pred1,arg1))::rest1) env
	 else
           mprolog  ( (Cla ( Pred ((pred,arg)::L )::rest ) 
                 ( (trasforma1(rest))@rest1) (trasforma(unifyrules) )
    end;
		       




(* stampa : environment --> unit.      Funzione che permette la  *)
(* stampa del risultato ottenuto dall' unificazione.             *)

fun stampa Fail = (print "No ";
                   ())
   |stampa (OK nil) = (print "Si ";
                       ())
   |stampa (OK ((a,b)::rest)) = (print(a);
                	  print "=";
			  print "b";
			  print "\n";
			  stampa(rest);
			  ())



















































(* regofat : (expr list) --> expr --> arg --> environment -->    *)
(*           'a possible.                                        *)
(* Funzione che data in ingresso una clausola una query e un     *)
(* ambiente, verifica se la clausola e' una regola o un fatto e  *)
(* se risulta essere una regola allora rinomina tutte le varia   *)
(* bili in essa presenti.                                        *)        

fun regofat ([Pred (pred,arg)]::[]) (pred1,arg1) (Var x) env = 
	  unify arg arg1 env
   |regofat ([Pred (pred,arg)]::L)) (pred1,arg1) (Var x) env =
	  unifyarg (hd(rinomtut ([Pred (pred,arg)]::L)) (Var x))) arg1 env;



(* rinomina : expr --> arg --> expr.       Funzione che permette *)
(* di rinominare tutti gli argomenti di una regola.              *)   

fun rinomina (Pred (pred1,argo1)) (Var x) =
  let

    fun aux (Pred (pred1,argo1::rest1)) (Var x) =
	 if (argo1=(Var x)) 
      then ((Var(x^"'"))::(aux (Pred (pred1,rest1)) (Var x)) )               
	 else (argo1::(aux (Pred (pred1,rest1)) (Var x)) );
 
in
    (Pred (pred1,aux (Pred (pred1,argo1)) (Var x)) 
  end;


(* rinomtut : clausola --> arg --> clausola.     Funzione che per*)
(* mette di rinominare tutte le variabili presenti in una regola *)

fun rinomtut  (Pred (pred1,argo1)))::rest)  (Var x) = 
  (rinomina (Pred (pred1,argo1)) (Var x))::(rinomtut (rest) (Var x)) ;
Per qualsiasi chiarimento