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)) ;