Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

[fix] libnet: Quick temporary fix for genproto dependency analysis. R…

…aft of unused value fixes.
  • Loading branch information...
commit d2218c4455a65cdd32020a3ed82a2a97c44551cd 1 parent cc4975a
@nrs135 nrs135 authored
View
2  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 ("#<Debugvar:"^s^">") | _ -> assert false) dbgvars
View
2  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
View
4 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 (
View
6 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
View
4 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 _ ->
#<If> Logger.warning "[DIRECTORY] Make : Uncaught exn"
#<Else> ()
#<End>)
View
1  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 " "
View
4 ocamllib/libnet/ftpServerCore.proto
@@ -89,6 +89,10 @@
rt_proto : rt_proto;
}
+{{
+let _ = ec2ecsa
+}}
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% General states %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
View
76 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[39m" color ld
+ Printf.sprintf "[%dm%016Lx[39m" 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^"[0m"
+ !s^"[0m"*)
-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:
View
2  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
View
2  ocamllib/libnet/http/requestLex.mll
@@ -18,7 +18,7 @@
(* The lexer definition *)
{
open RequestParse
-open Printf
+(*open Printf*)
type lexical_error = Illegal_character
View
2  ocamllib/libnet/http/requestParse.mly
@@ -20,7 +20,7 @@
%{
open Requestdef
open RequestType
- open Printf
+ (*open Printf*)
%}
/*(* Tokens *)*/
View
4 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 <http://www.gnu.org/licenses/>.
*)
-open Printf
-open Option
+(*open Printf*)
+(*open Option*)
open Rp_typ
open Rp_hdr
open Requestdef
View
2  ocamllib/libnet/http/requestUlex.ml
@@ -17,7 +17,7 @@
*)
(* The lexer definition *)
open RequestParse
-open Printf
+(*open Printf*)
type lexical_error = Illegal_character
View
4 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
View
5 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...
View
4 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 (
View
1  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
View
1  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)
}}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
View
1  ocamllib/libnet/smtpServerCore.proto
@@ -51,6 +51,7 @@
}
{{
+let _ = ec2ecsa
let rec msglst = function
| [] -> []
| [(c,s)] -> [Ns (c,s)]
View
2  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
Please sign in to comment.
Something went wrong with that request. Please try again.