From d2218c4455a65cdd32020a3ed82a2a97c44551cd Mon Sep 17 00:00:00 2001 From: Norman Scaife Date: Wed, 21 Nov 2012 17:07:20 +0100 Subject: [PATCH] [fix] libnet: Quick temporary fix for genproto dependency analysis. Raft of unused value fixes. --- compiler/protocols/genproto.ml | 2 +- compiler/protocols/reorder_functions.ml | 2 +- compiler/protocols/rewrite_funs.ml | 4 +- ocamllib/libnet/cluster.ml | 6 +- ocamllib/libnet/directory.ml | 4 +- ocamllib/libnet/ftpClientCore.proto | 1 + ocamllib/libnet/ftpServerCore.proto | 4 ++ ocamllib/libnet/hlnet.ml | 76 ++++++++++++------------- ocamllib/libnet/http/accept.ml | 2 +- ocamllib/libnet/http/requestLex.mll | 2 +- ocamllib/libnet/http/requestParse.mly | 2 +- ocamllib/libnet/http/requestRaw.ml | 4 +- ocamllib/libnet/http/requestUlex.ml | 2 +- ocamllib/libnet/http/userCompat.ml | 4 +- ocamllib/libnet/httpServerCore.proto | 5 +- ocamllib/libnet/http_common.ml | 4 +- ocamllib/libnet/imapClientCore.proto | 1 + ocamllib/libnet/smtpClientCore.proto | 1 + ocamllib/libnet/smtpServerCore.proto | 1 + tools/teerex/trx_ocaml.ml | 2 +- 20 files changed, 70 insertions(+), 59 deletions(-) diff --git a/compiler/protocols/genproto.ml b/compiler/protocols/genproto.ml index b23e7be6..2b1d4805 100644 --- a/compiler/protocols/genproto.ml +++ b/compiler/protocols/genproto.ml @@ -286,7 +286,7 @@ let gen_functor ~protocol parserprefix parsername arg lst types startfun = @ [O.Verbatim launch] in O.Open [Ident.source "Base"] - :: O.Open [Ident.source "Scheduler"] + (*:: O.Open [Ident.source "Scheduler"]*) :: O.Open [Ident.source (String.capitalize parsername)] (*:: List.map (function MOpen s -> O.Open [Ident.source s] | _ -> assert false) opens*) :: List.map (function G.Debugvar s -> O.Verbatim ("#") | _ -> assert false) dbgvars diff --git a/compiler/protocols/reorder_functions.ml b/compiler/protocols/reorder_functions.ml index 2bd02dba..5f77c1d1 100644 --- a/compiler/protocols/reorder_functions.ml +++ b/compiler/protocols/reorder_functions.ml @@ -118,7 +118,7 @@ let do_it lst = let funs = B.Hashtbl.create <| L.length lst in let () = init_table funs lst in let deps_list = get_dep_list funs lst in - let ccl = reorder deps_list in + let ccl = [List.flatten(reorder deps_list)] in (* Tag functions as normal or [mutually-]recursive *) try L.map (flag_as_rec funs) ccl diff --git a/compiler/protocols/rewrite_funs.ml b/compiler/protocols/rewrite_funs.ml index 7504bd3f..1500e413 100644 --- a/compiler/protocols/rewrite_funs.ml +++ b/compiler/protocols/rewrite_funs.ml @@ -114,13 +114,13 @@ and receive rfn success errors timeout = let clauses = match timeout with | None -> clauses | Some (G.Timeout ( _, what_to_do)) -> - let clause = G.Case ((G.Constr ("Timeout", []), None), what_to_do) in + let clause = G.Case ((G.Constr ("Scheduler.Timeout", []), None), what_to_do) in clause :: clauses | _ -> assert false in let clauses = match L.map rewrite_clause clauses with | [] -> [O.PatAny, None, O.Const O.Unit] - | [((O.PatConstructor ([timeout], _) as patconst), g, re)] when Ident.stident timeout = "Timeout" -> + | [((O.PatConstructor ([timeout], _) as patconst), g, re)] when Ident.stident timeout = "Scheduler.Timeout" -> (patconst, g, re) :: [O.PatAny, None, O.Const O.Unit] | otherwise -> otherwise in O.Var ( diff --git a/ocamllib/libnet/cluster.ml b/ocamllib/libnet/cluster.ml index b483fd7e..5c06b2a4 100644 --- a/ocamllib/libnet/cluster.ml +++ b/ocamllib/libnet/cluster.ml @@ -74,7 +74,7 @@ let get_id dc addr = | -1 -> failwith (Printf.sprintf "[Cluster] Unknown clunser ode... %s" (sockaddr_to_string addr)) | i -> i -let node_id_to_debug_string = string_of_int +(*let node_id_to_debug_string = string_of_int*) let node_id_to_string dc node_id = let addr = get_addr dc node_id in @@ -131,9 +131,9 @@ let random_server_id ?including_myself dc = let servers_no ?including_myself dc = List.length (all_server_ids ?including_myself dc) -let all_server_endpoints ?including_myself dc = +(*let all_server_endpoints ?including_myself dc = let ss = all_server_ids ?including_myself dc in - List.map (get_addr dc) ss + List.map (get_addr dc) ss*) let node_id_to_int node_id = node_id diff --git a/ocamllib/libnet/directory.ml b/ocamllib/libnet/directory.ml index 6e64565e..dafbeae3 100644 --- a/ocamllib/libnet/directory.ml +++ b/ocamllib/libnet/directory.ml @@ -23,7 +23,7 @@ module Hashtbl = Base.Hashtbl (* ********************************************************) (* DEFINE TYPE FOR HLNET PROTOCOL *************************) -type kind = Dir | Loc +(*type kind = Dir | Loc*) type who = Me | Other of Unix.inet_addr @@ -124,7 +124,7 @@ module ExtendHash = struct | x -> x end -let rec make ?(err_cont=fun _ -> +let make ?(err_cont=fun _ -> # Logger.warning "[DIRECTORY] Make : Uncaught exn" # () #) diff --git a/ocamllib/libnet/ftpClientCore.proto b/ocamllib/libnet/ftpClientCore.proto index 28f541c6..5e3a2b54 100644 --- a/ocamllib/libnet/ftpClientCore.proto +++ b/ocamllib/libnet/ftpClientCore.proto @@ -70,6 +70,7 @@ -include "ftpMessages.proto" {{ +let _ = (compare_msg,get_msg_name,ec2ecsa) let dlog sep code _msg = Logger.debug "<<< %d%s%s" code sep _msg let eilog = dlog "-" let ilog = dlog " " diff --git a/ocamllib/libnet/ftpServerCore.proto b/ocamllib/libnet/ftpServerCore.proto index 3ec811e9..4b2c6681 100644 --- a/ocamllib/libnet/ftpServerCore.proto +++ b/ocamllib/libnet/ftpServerCore.proto @@ -89,6 +89,10 @@ rt_proto : rt_proto; } +{{ +let _ = ec2ecsa +}} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% General states %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/ocamllib/libnet/hlnet.ml b/ocamllib/libnet/hlnet.ml index f0abab52..2ba7a217 100644 --- a/ocamllib/libnet/hlnet.ml +++ b/ocamllib/libnet/hlnet.ml @@ -38,10 +38,10 @@ let protocol_version = 1 let gc_finalise _sched = Scheduler.finalise _sched -let apply_fun_option opt = +(*let apply_fun_option opt = match opt with | Some f -> f - | None -> fun _ -> () + | None -> fun _ -> ()*) (* ------------------------------------------------------------ *) @@ -268,15 +268,15 @@ let hexprint ?(chars_per_line=32) s = String.blit sfx 0 buf (String.length buf - sfxlen) sfxlen; buf -let int64_to_debug_string ld = +(*let int64_to_debug_string ld = let color = 31 + Int64.to_int (Int64.rem ld (Int64.of_int 6)) in - Printf.sprintf "[%dm%016Lx" color ld + Printf.sprintf "[%dm%016Lx" color ld*) let int_to_debug_string i = let color = 31 + i mod 6 in Printf.sprintf "[%dm%016x" color i -let print_marshalled str beg = +(*let print_marshalled str beg = let s = ref "" in for i = beg to String.length str -1 do let topr = @@ -286,13 +286,13 @@ let print_marshalled str beg = else Char.escaped str.[i] in s := !s ^ "-" ^ topr done; - !s^"" + !s^""*) -let string_of_htable keystr valstr ht = +(*let string_of_htable keystr valstr ht = Format.fprintf Format.str_formatter "(%d) - %a" (H.length ht) (fun f -> H.iter (fun k v -> Format.fprintf f "{ %s+%s }|" (keystr k) (valstr v))) ht; - Format.flush_str_formatter () + Format.flush_str_formatter ()*) (* -- Type specific -- *) @@ -421,19 +421,19 @@ let is_channel_listening ch = (* Serialisation / deserialisation *) (* ------------------------------------------------------------ *) -let write_int64 buf offset i = +(*let write_int64 buf offset i = let (>>) = Int64.shift_right_logical in for byte = 0 to 7 do buf.[offset + byte] <- Char.chr (Int64.to_int (i >> (8* (7 - byte))) land 0xFF) - done + done*) -let read_int64 buf offset = +(*let read_int64 buf offset = let (<<) = Int64.shift_left in let rec aux offset value byte = if byte >= 8 then value else aux offset (Int64.logor value (Int64.of_int (Char.code buf.[offset+byte]) << (8 * (7 - byte)))) (byte+1) in - aux offset Int64.zero 0 + aux offset Int64.zero 0*) let write_int buf offset i = for byte = 0 to 7 do @@ -595,7 +595,7 @@ struct - a string using the serialisation functions provided by the user in the channel_spec *) - let message_shebang = 'M' + (*let message_shebang = 'M'*) let shebang_length = 1 let message_header_length = shebang_length + 8 + 8 @@ -731,7 +731,7 @@ module Connection : sig (** Same as [get], but does not attempt to connect, just return the connection if existing *) - val find: endpoint -> connection option + (*val find: endpoint -> connection option*) (** Registers an already open low-level connection (e.g. returned by [accept]). Warning, the connection will be closed if you let the returned @@ -766,7 +766,7 @@ module Connection : sig val dump: unit -> string - val live_channels: unit -> int + (*val live_channels: unit -> int*) end = struct let table = Wconnections.create 11 @@ -895,7 +895,7 @@ end = struct gc_finalise sched disconnect connection; connection - let find = Wconnections.get_opt table + (*let find = Wconnections.get_opt table*) let register_channel channel = let channel = channel_to_black channel in @@ -931,10 +931,10 @@ end = struct (fun c acc -> Printf.sprintf "%s%s\n" acc (connection_to_string c)) table "" - let live_channels () = + (*let live_channels () = Wconnections.fold (fun c acc -> acc + Wchannels.count c.channels) - table 0 + table 0*) end @@ -973,7 +973,7 @@ module PolyHash (V : sig type key type ('out', 'in') value - val key2str: key -> string + (*val key2str: key -> string*) end) : sig (* This module provides semi-heterogeneous hashtables, needed to handle channels @@ -989,9 +989,9 @@ sig val find : t -> V.key -> ('out','in') V.value option val mem : t -> V.key -> bool val remove : t -> V.key -> unit - val update : t -> V.key -> (('out','in') V.value -> ('out','in') V.value) -> unit - val fold : t -> (V.key -> ('out','in') V.value -> 'acc -> 'acc) -> 'acc -> 'acc - val to_string : t -> string + (*val update : t -> V.key -> (('out','in') V.value -> ('out','in') V.value) -> unit*) + (*val fold : t -> (V.key -> ('out','in') V.value -> 'acc -> 'acc) -> 'acc -> 'acc*) + (*val to_string : t -> string*) end = struct type t = (V.key, Obj.t) H.t @@ -1006,21 +1006,21 @@ end = struct let mem = H.mem - let to_string tbl = - BaseList.print V.key2str (H.fold (fun k _v acc -> k::acc) tbl []) + (*let to_string tbl = + BaseList.print V.key2str (H.fold (fun k _v acc -> k::acc) tbl [])*) let remove tbl k = H.remove tbl k - let update tbl k f = + (*let update tbl k f = try let v = H.find tbl k in let new_v = Obj.repr (f ((Obj.obj v) : ('out','in') V.value)) in H.replace tbl k new_v - with Not_found -> () + with Not_found -> ()*) - let fold (tbl : t) f acc = - H.fold (fun k v acc -> f (k:V.key) ((Obj.obj v) : ('out','in') V.value) acc) tbl acc + (*let fold (tbl : t) f acc = + H.fold (fun k v acc -> f (k:V.key) ((Obj.obj v) : ('out','in') V.value) acc) tbl acc*) end @@ -1029,15 +1029,15 @@ end module EP : sig val add: endpoint -> ('out', 'in') connection_handler -> unit val find: endpoint -> ('out', 'in') connection_handler option - val update: endpoint -> (('out', 'in') connection_handler -> ('out', 'in') connection_handler) -> unit + (*val update: endpoint -> (('out', 'in') connection_handler -> ('out', 'in') connection_handler) -> unit*) val remove: endpoint -> unit - val to_string: unit -> string + (*val to_string: unit -> string*) end = struct module E = struct type key = endpoint type ('out','in') value = ('out', 'in') connection_handler - let key2str = endpoint_to_string + (*let key2str = endpoint_to_string*) end module EPH = PolyHash(E) (** Hash from (local) endpoints to their connection handler *) @@ -1056,10 +1056,10 @@ end = struct let remove ep = EPH.remove table ep - let update ep f = - EPH.update table ep f + (*let update ep f = + EPH.update table ep f*) - let to_string () = EPH.to_string table + (*let to_string () = EPH.to_string table*) end @@ -1068,13 +1068,13 @@ end module ChanH : sig val add : ('out','in') channel -> unit val find: channel_id -> black_channel option - val mem: channel_id -> bool + (*val mem: channel_id -> bool*) val remove: channel_id -> unit (** If [propagate] (the default), inform the other end of the deletion *) val to_string: unit -> string - val count: unit -> int + (*val count: unit -> int*) end = struct let table = H.create 89 @@ -1084,7 +1084,7 @@ end = struct H.replace table chan.id (channel_to_black chan) (* Strong ref, CH is for channels with pending operations, we hold it in memory *) - let mem id = H.mem table id + (*let mem id = H.mem table id*) let find id = Base.Hashtbl.find_opt table id @@ -1101,7 +1101,7 @@ end = struct (fun id _chan acc -> Printf.sprintf "%s, %s" acc (channel_id_to_debug_string id)) table "" - let count () = H.length table + (*let count () = H.length table*) end (* Channels have two special closing treatments: diff --git a/ocamllib/libnet/http/accept.ml b/ocamllib/libnet/http/accept.ml index 7338aeae..85ac1139 100644 --- a/ocamllib/libnet/http/accept.ml +++ b/ocamllib/libnet/http/accept.ml @@ -18,7 +18,7 @@ (* Accept: see the interface file for docs. *) open Printf open HttpTools -open HttpServerTypes +(*open HttpServerTypes*) (* depends *) module List = BaseList diff --git a/ocamllib/libnet/http/requestLex.mll b/ocamllib/libnet/http/requestLex.mll index e54b4716..4c5a9247 100644 --- a/ocamllib/libnet/http/requestLex.mll +++ b/ocamllib/libnet/http/requestLex.mll @@ -18,7 +18,7 @@ (* The lexer definition *) { open RequestParse -open Printf +(*open Printf*) type lexical_error = Illegal_character diff --git a/ocamllib/libnet/http/requestParse.mly b/ocamllib/libnet/http/requestParse.mly index d0c4149b..dae271d1 100644 --- a/ocamllib/libnet/http/requestParse.mly +++ b/ocamllib/libnet/http/requestParse.mly @@ -20,7 +20,7 @@ %{ open Requestdef open RequestType - open Printf + (*open Printf*) %} /*(* Tokens *)*/ diff --git a/ocamllib/libnet/http/requestRaw.ml b/ocamllib/libnet/http/requestRaw.ml index 50c59392..93990dfb 100644 --- a/ocamllib/libnet/http/requestRaw.ml +++ b/ocamllib/libnet/http/requestRaw.ml @@ -15,8 +15,8 @@ You should have received a copy of the GNU Affero General Public License along with Opa. If not, see . *) -open Printf -open Option +(*open Printf*) +(*open Option*) open Rp_typ open Rp_hdr open Requestdef diff --git a/ocamllib/libnet/http/requestUlex.ml b/ocamllib/libnet/http/requestUlex.ml index dc8ea9c1..2dd04f6a 100644 --- a/ocamllib/libnet/http/requestUlex.ml +++ b/ocamllib/libnet/http/requestUlex.ml @@ -17,7 +17,7 @@ *) (* The lexer definition *) open RequestParse -open Printf +(*open Printf*) type lexical_error = Illegal_character diff --git a/ocamllib/libnet/http/userCompat.ml b/ocamllib/libnet/http/userCompat.ml index 7c6db842..b86cf60e 100644 --- a/ocamllib/libnet/http/userCompat.ml +++ b/ocamllib/libnet/http/userCompat.ml @@ -20,9 +20,9 @@ module String = BaseString module List = BaseList -open Printf +(*open Printf*) open UserCompatType -open Rp_brow +(*open Rp_brow*) module UCT = UserCompatType module HSCp = HttpServerCore_parse diff --git a/ocamllib/libnet/httpServerCore.proto b/ocamllib/libnet/httpServerCore.proto index 6afe0151..c3e56ccb 100644 --- a/ocamllib/libnet/httpServerCore.proto +++ b/ocamllib/libnet/httpServerCore.proto @@ -116,6 +116,7 @@ -val null_payload : payload {{ +let _ = ec2ecsa let allowed_hosts = ref [] let http_version_number = "1.1" let http_version = "HTTP/"^http_version_number @@ -177,8 +178,8 @@ let http_server_callback runtime (buf,pos_ref) = match runtime.rt_tmp.rt_callback with | Some cb -> cb runtime.rt_proto.rt_payload !pos_ref buf | None -> true -let split_cookie str = - List.map (fun x -> let a, b = String.split_char '=' x in ((String.trim a), b)) (String.slice ';' str) +(*let split_cookie str = + List.map (fun x -> let a, b = String.split_char '=' x in ((String.trim a), b)) (String.slice ';' str)*) }} % FIXME: parse this... diff --git a/ocamllib/libnet/http_common.ml b/ocamllib/libnet/http_common.ml index febd6538..9866ef7e 100644 --- a/ocamllib/libnet/http_common.ml +++ b/ocamllib/libnet/http_common.ml @@ -23,7 +23,7 @@ open Requestdef let version = string_of_int BuildInfos.git_version_counter let crlf = "\r\n" -let double_crlf = crlf ^ crlf +(*let double_crlf = crlf ^ crlf*) (** {6 Request} *) @@ -105,6 +105,7 @@ let string_of_response ?(body_limit=1024) r = (* crlf *) (* (r.response_message_body) *) +(* let parse_response response = let str = FBuffer.contents response in try @@ -113,6 +114,7 @@ let parse_response response = with | Trx_runtime.SyntaxError (loc, err) -> failwith (Printf.sprintf "Failed to parse http response: %s --> %s" str (Trx_runtime.show_error str loc err)) +*) let print_response_header resp = ResponseHeader.iter ( diff --git a/ocamllib/libnet/imapClientCore.proto b/ocamllib/libnet/imapClientCore.proto index 64fab1f8..8fd814e0 100644 --- a/ocamllib/libnet/imapClientCore.proto +++ b/ocamllib/libnet/imapClientCore.proto @@ -105,6 +105,7 @@ } {{ +let _ = (compare_msg,get_msg_name,ec2ecsa) let get_tag() = Printf.sprintf "A%05d" (Random.int(65535-4096)+4096) let string_of_command = function | ImapSelect s -> sprintf "SELECT %s" s diff --git a/ocamllib/libnet/smtpClientCore.proto b/ocamllib/libnet/smtpClientCore.proto index 7b9fbd5b..c68ba115 100644 --- a/ocamllib/libnet/smtpClientCore.proto +++ b/ocamllib/libnet/smtpClientCore.proto @@ -67,6 +67,7 @@ {{ let encode_plain user pass = String.base64encode(sprintf "\000%s\000%s" user pass) +let _ = (compare_msg,get_msg_name,ec2ecsa) }} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/ocamllib/libnet/smtpServerCore.proto b/ocamllib/libnet/smtpServerCore.proto index 0d8d5d55..f57d1590 100644 --- a/ocamllib/libnet/smtpServerCore.proto +++ b/ocamllib/libnet/smtpServerCore.proto @@ -51,6 +51,7 @@ } {{ +let _ = ec2ecsa let rec msglst = function | [] -> [] | [(c,s)] -> [Ns (c,s)] diff --git a/tools/teerex/trx_ocaml.ml b/tools/teerex/trx_ocaml.ml index e3e87824..3c1161c4 100644 --- a/tools/teerex/trx_ocaml.ml +++ b/tools/teerex/trx_ocaml.ml @@ -573,7 +573,7 @@ let match_literal ctx literal case offset success failure = if case then OcamlG.equal input_char literal_char else - call_fun [vars ["Char"; "equal_insensitive"]; input_char; literal_char] + call_fun [vars ["Base.Char"; "equal_insensitive"]; input_char; literal_char] in OcamlG.band cmp_this_char (aux (i + 1)) in