Il suffit alors d'appeler ces fonctions en début et en fin de boucle d'un philosophe.
#letentrer,sortir=letn=ref0inletm=Mutex.create()inletc=Condition.create()inletloc_entrer()=Mutex.lockm;whilenot(!n<4)doCondition.waitcmdone;incrn;if!n>1thenPrintf.printf"%d philosophes sont a table\n"!nelsePrintf.printf"%d philosophe est a table\n"!n;flushstdout;Mutex.unlockminletloc_sortir()=Mutex.lockm;decrn;Mutex.unlockm;Condition.broadcastcinloc_entrer,loc_sortir;;val entrer : unit -> unit = <fun>val sortir : unit -> unit = <fun>
Attention, cette solution supprime les inter-blocages, mais pas les famines. Pour résoudre ce dernier problème, on peut soit se fier au hasard en introduisant un délai d'attente en aprés la sortie d'un philosophe, soit gérer explicitement une file d'attente.
# letphilosophei=letii=(i+1)mod4inwhiletruedoPrintf.printf"Le philosophe (%d) se pointe\n"i;entrer();mediter3.;Mutex.lockb.(i);Printf.printf"Le philosophe (%d) prend sa baguette gauche et medite encore un peu\n"i;mediter0.2;Mutex.lockb.(ii);Printf.printf"Le philosophe (%d) prend sa baguette droite\n"i;manger0.5;Mutex.unlockb.(i);Printf.printf"Le philosophe (%d) rend sa baguette gauche et commence deja a mediter\n"i;mediter0.15;Mutex.unlockb.(ii);Printf.printf"Le philosophe (%d) rend sa baguette droite\n"i;sortir();Printf.printf"Le philosophe (%d) se tire\n"i;done;;val philosophe : int -> unit = <fun>
# classdistrib()=objectvalmutablen=0valm=Mutex.create()valc=Condition.create()methodattendrenc=Mutex.lockm;while(n<=nc)doCondition.waitcmdone;Mutex.unlockmmethodprendre()=Mutex.lockm;n<-n+1;letnn=ninCondition.broadcastc;Mutex.unlockm;nnend;;class distrib :unit ->objectval c : Condition.tval m : Mutex.tval mutable n : intmethod attendre : int -> unitmethod prendre : unit -> intend
#methodprivatereveilt=letdt=delai_attente_appel/.10.0inwhile(Unix.gettimeofday()<t)doThread.delaydtdone;Condition.signalcmethodattendre_arrivee()=lett=Unix.gettimeofday()+.delai_attente_appelinletr=Thread.createself#reveiltinMutex.lockm;whilelibre&&(Unix.gettimeofday()<t)doCondition.waitcmdone;(tryThread.killrwith_->());letb=notlibrein(Mutex.unlockm;b)
# classaffich(d:distrib)=objectvalmutablenc=0valm=Mutex.create()valc=Condition.create()methodattendren=Mutex.lockm;whilenc<ndoCondition.waitcmdone;Mutex.unlockmmethodattendre_jusqu'ant=Mutex.lockm;while(nc<n)&&(Unix.gettimeofday()<t)doCondition.waitcmdone;letb=not(nc<n)inMutex.unlockm;bmethodappel(g:guichet)=Mutex.lockm;d#attendrenc;nc<-nc+1;g#set_ncnc;Condition.broadcastc;Mutex.unlockmend;;class affich :distrib ->objectval c : Condition.tval m : Mutex.tval mutable nc : intmethod appel : guichet -> unitmethod attendre : int -> unitmethod attendre_jusqu'a : int -> float -> boolend
#type bureau = { d: distrib; a: affich; gs: guichet array }val delai_service : float = 4val delai_arrivee : float = 2val delai_guichet : float = 0.5val delai_attente_client : float = 0.7letguichetier((a:affich),(g:guichet))=whiletruedoa#appelg;Printf.printf"Guichet %d appelle %d\n"g#get_ngg#get_nc;ifg#attendre_arrivee()theng#attendre_depart()elsebeginPrintf.printf"Guichet %d n'attend plus %d\n"g#get_ngg#get_nc;flushstdoutend;Thread.delay(Random.floatdelai_guichet)done;;val guichetier : affich * guichet -> unit = <fun>
#val chercher_guichet : 'a -> < get_nc : 'a; .. > array -> int = <fun>letclient_impatientb=letn=b.d#prendre()inlett=Unix.gettimeofday()+.(Random.floatdelai_attente_client)inPrintf.printf"Arrivee client impatient %d\n"n;flushstdout;ifb.a#attendre_jusqu'antthenletig=chercher_guichetnb.gsinb.gs.(ig)#arriver();Printf.printf"Le client %d occupe le guichet %d\n"nig;flushstdout;Thread.delay(Random.floatdelai_service);b.gs.(ig)#partir();Printf.printf"Le client %d s'en va\n"nelsePrintf.printf"Le client %d, las d'attendre, s'en va\n"nflushstdout;;Characters 518-531:This function is applied to too many arguments
# classproduit(s:string)=objectvalnom=smethodnom=nomend;;class produit : string -> object val nom : string method nom : string end
classproduit:string->objectvalnom:stringmethodnom:stringend
# classmagasinn=object(self)valmutabletaille=n;valmutablenp=0valmutablebuffer=([||]:produitarray)valmutableip=0(* Indice producteur *)valmutableic=0(* Indice consommateur *)valm=Mutex.create()valc=Condition.create()initializerbuffer<-Array.createn(newproduit"empty")methoddisplay1()=leti=ipmodtailleinPrintf.printf"Ajout (%d)%s\n"i((buffer.(i))#nom)methoddeposerp=Mutex.lockm;while(ip-ic+1>Array.length(buffer))doCondition.waitcmdone;buffer.(ipmodtaille)<-p;self#display1();ip<-ip+1;Mutex.unlockm;Condition.signalcmethoddisplay2()=leti=icmodtailleinPrintf.printf"Retrait (%d)%s\n"i((buffer.(i))#nom)methodprendre()=Mutex.lockm;while(ip==ic)doCondition.waitcmdone;self#display2();letr=buffer.(icmodtaille)inic<-ic+1;Mutex.unlockm;Condition.signalc;rend;;class magasin :int ->objectval mutable buffer : produit arrayval c : Condition.tval mutable ic : intval mutable ip : intval m : Mutex.tval mutable np : intval mutable taille : intmethod deposer : produit -> unitmethod display1 : unit -> unitmethod display2 : unit -> unitmethod prendre : unit -> produitend
Les indices ic et ip sont manipulés respectivement par les producteurs et les consommateurs. L'indice ic donne l'indice du dernier produit pris et ip celui du dernier produit stocké. Le compteur np donne le nombre de produits en stock. L'exclusion mutuelle et la mise en attente des producteurs et des consommateurs seront gérées par les méthodes de cette classe.
classmagasin:int->objectvalmutablebuffer:produitarrayvalc:Condition.tvalmutableic:intvalmutableip:intvalm:Mutex.tvalmutablenp:intvaltaille:intmethoddeposer:produit->unitmethodprendre:unit->produitend
-> string -> unit.
# letconsommateurmagna=whiletruedoletp=mag#prendre()inPrintf.printf"Le consommateur %s prend le produit %s\n"nap#nom;flushstdout;Thread.delay(Random.float(3.0))done;;val consommateur :< prendre : unit -> < nom : string; .. >; .. > -> string -> unit = <fun>
-> string -> unit.
# letproducteur=letnum=ref0inletcreer_produit()=letp=newproduit("lessive-"^(string_of_int!num))inincrnum;pinfunctionmag->functionnm->whiletruedoletp=creer_produit()inmag#deposer(p);Printf.printf"Production de %s\n"p#nom;flushstdout;Thread.delay(Random.float(1.0))done;;val producteur : < deposer : produit -> '_a; _.. > -> '_b -> unit = <fun>