# typehorloge={jour:int;mois:int;heure:int;minute:int;seconde:int};;type horloge ={ jour: int;mois: int;heure: int;minute: int;seconde: int }
# letencodedate=letstr=String.create5instr.[0]<-char_of_intdate.jour;str.[1]<-char_of_intdate.mois;str.[2]<-char_of_intdate.heure;str.[3]<-char_of_intdate.minute;str.[4]<-char_of_intdate.seconde;str;;val encode : horloge -> string = <fun>
# letdecodestr={jour=int_of_charstr.[0];mois=int_of_charstr.[1];heure=int_of_charstr.[2];minute=int_of_charstr.[3];seconde=int_of_charstr.[4]};;val decode : string -> horloge = <fun>
# main_serveur;;- : (in_channel -> out_channel -> 'a) -> unit = <fun>
# lethorloge_serviceicoc=tryletdate=Unix.localtime(Unix.time())inletdate_horloge={jour=date.Unix.tm_mday;mois=date.Unix.tm_mon+1;heure=date.Unix.tm_hour;minute=date.Unix.tm_min;seconde=date.Unix.tm_sec}inoutput_stringoc(encodedate_horloge);flushocwithexn->print_endline"Fin du traitement";flushstdoutletmain_horloge()=main_serveurhorloge_service;;val horloge_service : 'a -> out_channel -> unit = <fun>val main_horloge : unit -> unit = <fun>
# main_client;;- : (in_channel -> out_channel -> 'a) -> unit = <fun>
# letclient_horlogeicoc=letdate=ref{jour=0;mois=0;heure=0;minute=0;seconde=0}intrywhiletruedoletbuffer="xxxxx"inignore(inputicbuffer05);date:=decodebuffer;print_endline"BIP";flushstdout;Unix.sleep3600donewithexn->shutdown_connectionic;raiseexn;;val client_horloge : in_channel -> 'a -> unit = <fun>
# letmain_horloge()=main_clientclient_horloge;;val main_horloge : unit -> unit = <fun>
:$\n.
#val hostaddr : string -> Unix.inet_addr = <fun>val my_inet_addr : unit -> Unix.inet_addr = <fun>letestablish_serverfsaddr=letsock=ThreadUnix.socketUnix.PF_INETUnix.SOCK_STREAM0inUnix.bindsocksaddr;Unix.listensock5;whiletruedolet(s,_)=ThreadUnix.acceptsockinletic=Unix.in_channel_of_descrsandoc=Unix.out_channel_of_descrsinignore(Thread.create(fic)oc)done;;val establish_server :(in_channel -> out_channel -> 'a) -> Unix.sockaddr -> unit = <fun>
# letreadfd=letbuf=String.create1024inletn=ThreadUnix.readfdbuf01024inlets=String.subbuf0nins;;val read : Unix.file_descr -> string = <fun>
# letget_requestfd=lets=readfdinmatchStr.split(Str.regexp"[:]")(String.subs0(String.indexs'$'))with[s1]->s1|_->failwith"BadRequestFormat";;val get_request : Unix.file_descr -> string = <fun>
# letwritefds=letleng=(String.lengths)inletn=ThreadUnix.writefds0lenginifn<lengthenfailwith"I/O error";;val write : Unix.file_descr -> string -> unit = <fun>
# letsend_answerfdss=letrecmk_answer=function[]->":$\n"|[s]->s^":$\n"|s::ss->s^":"^(mk_answerss)inwritefd(mk_answerss);;val send_answer : Unix.file_descr -> string list -> unit = <fun>
# letsend_cancel=lets="cancel:$\n"infunctionfd->writefds;;val send_cancel : Unix.file_descr -> unit = <fun>
# classcmd_fifo=object(self)valn=newnum_cmd_genvalf=(Queue.create():(int*int*int)Queue.t)valm=Mutex.create()valc=Condition.create()methodaddnum_drinkpaid=letnum_cmd=n#get()inMutex.lockm;Queue.add(num_cmd,num_drink,paid)f;Mutex.unlockm;Condition.signalc;num_cmdmethodwait()=Mutex.lockm;Condition.waitcm;letcmd=Queue.takefinMutex.unlockm;cmdend;;class cmd_fifo :objectval c : Condition.tval f : (int * int * int) Queue.tval m : Mutex.tval n : num_cmd_genmethod add : int -> int -> intmethod wait : unit -> int * int * intend
# classnum_cmd_gen=objectvalmutablex=0valm=Mutex.create()methodget()=Mutex.lockm;x<-x+1;letr=xinMutex.unlockm;rend;;class num_cmd_gen :object val m : Mutex.t val mutable x : int method get : unit -> int end
# classready_tablesize=objectvalt=(Hashtbl.createsize:(int,(string*int))Hashtbl.t)valm=Mutex.create()valc=Condition.create()methodaddnum_cmdnum_drinkchange=Mutex.lockm;Hashtbl.addtnum_cmd(num_drink,change);Mutex.unlockm;Condition.broadcastcmethodwaitnum_cmd=Mutex.lockm;whilenot(Hashtbl.memtnum_cmd)doCondition.waitcmdone;letcmd=Hashtbl.findtnum_cmdinHashtbl.removetnum_cmd;Mutex.unlockm;cmdend;;class ready_table :int ->objectval c : Condition.tval m : Mutex.tval t : (int, string * int) Hashtbl.tmethod add : int -> string -> int -> unitmethod wait : int -> string * intend
# classmachine(f_cmd0:cmd_fifo)(t_ready0:ready_table)=object(self)valf_cmd=f_cmd0valt_ready=t_ready0valmutablenb_available_drinks=0valdrinks_table=[|{name="cafe";real_stock=10;virtual_stock=10;price=300};{name="the";real_stock=5;virtual_stock=5;price=250};{name="chocolat";real_stock=10;virtual_stock=10;price=250}|]valmutablecash=0valm=Mutex.create()initializernb_available_drinks<-Array.lengthdrinks_tablemethodget_drink_pricei=drinks_table.(i).pricemethodget_drink_indexs=array_indexdrinks_table(fund->d.name=s)methodget_menu()=letfdns=ifd.real_stock>0thend.name::nselsensinArray.fold_rightfdrinks_table[]methodcancel_cmdnum_drink=letdrink=drinks_table.(num_drink)indrink.virtual_stock<-drink.virtual_stock+1methodset_cmdnum_drinkpaid=f_cmd#addnum_drinkpaidmethodwait_cmdnum_cmd=t_ready#waitnum_cmdmethoddeliver_drinknum_drink=letdrink=drinks_table.(num_drink)indrink.real_stock<-drink.real_stock-1;ifdrink.real_stock=0thennb_available_drinks<-nb_available_drinks-1methodrun()=whilenb_available_drinks>0dolet(num_cmd,num_drink,amount)=f_cmd#wait()inletdrink=drinks_table.(num_drink)inletchange=amount-drink.priceinMutex.lockm;if(drink.virtual_stock>0)&(cash>=change)thenbegindrink.virtual_stock<-drink.virtual_stock-1;cash<-cash+drink.price;t_ready#addnum_cmddrink.namechangeendelset_ready#addnum_cmd"cancel"0;Mutex.unlockmdoneend;;class machine :cmd_fifo ->ready_table ->objectval mutable cash : intval drinks_table : drink_descr arrayval f_cmd : cmd_fifoval m : Mutex.tval mutable nb_available_drinks : intval t_ready : ready_tablemethod cancel_cmd : int -> unitmethod deliver_drink : int -> unitmethod get_drink_index : string -> intmethod get_drink_price : int -> intmethod get_menu : unit -> string listmethod run : unit -> unitmethod set_cmd : int -> int -> intmethod wait_cmd : int -> string * intend
# typedrink_descr={name:string;mutablereal_stock:int;mutablevirtual_stock:int;price:int};;
# letarray_indextf=leti=ref0inletn=Array.lengthtinwhile(!i<n)&(not(ft.(!i)))doincridone;if!i=nthenraiseNot_foundelse!i;;val array_index : 'a array -> ('a -> bool) -> int = <fun>
# letwaitermachicoc=letf_in=Unix.descr_of_in_channelicinletf_out=Unix.descr_of_out_channelocin(trysend_answerf_out(mach#get_menu());letdrink_name=get_requestf_ininletnum_drink=mach#get_drink_indexdrink_nameinletdrink_price=mach#get_drink_pricenum_drinkinsend_answerf_out[string_of_intdrink_price];letpaid=int_of_string(get_requestf_in)inifpaid<drink_pricethenfailwith"NotEnough";letnum_cmd=mach#set_cmdnum_drinkpaidinletdrink_name,change=mach#wait_cmdnum_cmdinmach#deliver_drinknum_drink;send_answerf_out[drink_name;(string_of_intchange)]withNot_found->send_cancelf_out|Failure("int_of_string")->send_cancelf_out|Failure("I/O error")->send_cancelf_out|Failure("NotEnough")->send_cancelf_out|Failure("BadRequestFormat")->send_cancelf_out);close_inic;flushoc;close_outoc;Thread.exit();;val waiter :< deliver_drink : 'a -> 'b; get_drink_index : string -> 'a;get_drink_price : 'a -> int; get_menu : unit -> string list;set_cmd : 'a -> int -> 'c; wait_cmd : 'c -> string * int; .. > ->in_channel -> out_channel -> unit = <fun>
# letmain()=ifArray.lengthSys.argv<2thenbeginPrintf.eprintf"usage : %s port\n"Sys.argv.(0);exit1endelsebeginletport=int_of_stringSys.argv.(1)inletf_cmd=newcmd_fifoinlett_ready=newready_tableinletmach=newmachinef_cmd(t_ready13)inignore(Thread.createmach#run());establish_server(waitermach)(Unix.ADDR_INET(my_inet_addr(),port))end;;val main : unit -> unit = <fun>