From 24bb677ed2c83eeea29f01fa425c7982d90e8714 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Sun, 13 Nov 2016 11:27:31 +0000 Subject: [PATCH] fixes --- src/findlib.ml | 16 ++++++++-------- src/kind.ml | 2 +- src/loc.ml | 6 +++--- src/loc.mli | 4 ++-- src/meta.ml | 8 ++++---- src/meta_lexer.mll | 4 ++-- 6 files changed, 20 insertions(+), 20 deletions(-) diff --git a/src/findlib.ml b/src/findlib.ml index 64a4edb0..32e64aec 100644 --- a/src/findlib.ml +++ b/src/findlib.ml @@ -52,7 +52,7 @@ type package = let db = Hashtbl.create 1024 -let make_rule ((_, preds, action, value) : META.var) = +let make_rule ((_, preds, action, value) : Meta.var) = let preds_required, preds_forbidden = List.partition_map preds ~f:(function | P x -> Inl x @@ -64,14 +64,14 @@ let make_rule ((_, preds, action, value) : META.var) = ; value } -let acknowledge_meta (meta : META.t) = - let pkgs = META.flatten meta in +let acknowledge_meta (meta : Meta.t) = + let pkgs = Meta.flatten meta in List.iter pkgs ~f:(fun (name, vars) -> let vars = List.fold_left vars ~init:String_map.empty ~f:(fun acc ((vname, _, _, _) as var) -> let rule = make_rule var in let rules = - match String_map.find acc vname with + match String_map.find vname acc with | exception Not_found -> [] | rules -> rules in @@ -89,12 +89,12 @@ let root_pkg s = | i -> String.sub s ~pos:0 ~len:i let rec get_pkg name = - match Hashtbl.find db pkg with + match Hashtbl.find db name with | exception Not_found -> let root = root_pkg name in let fn = !findlib_dir ^/ root ^/ "META" in if Sys.file_exists fn then begin - acknowledge_meta { name = root; entries = META.load fn }; + acknowledge_meta { name = root; entries = Meta.load fn }; get_pkg name end else raise (Package_not_found name) @@ -111,12 +111,12 @@ let rec interpret_rules rules ~preds = | Add -> match interpret_rules rules ~preds with | None -> Some rule.value - | Some v -> Some (v ^ " " rule.value) + | Some v -> Some (v ^ " " ^ rule.value) else interpret_rules rules ~preds let get_var pkg ~preds var = - match String_map.find pkg.vars var with + match String_map.find var pkg.vars with | exception Not_found -> None | rules -> interpret_rules rules ~preds diff --git a/src/kind.ml b/src/kind.ml index 4c8c2744..b64691fa 100644 --- a/src/kind.ml +++ b/src/kind.ml @@ -45,6 +45,6 @@ let save kind ~filename x = let load kind ~filename = let sexp, _locs = - with_lexbuf_from_file filename ~f:Sexp_lexer.single lb + with_lexbuf_from_file filename ~f:Sexp_lexer.single in of_sexp kind sexp diff --git a/src/loc.ml b/src/loc.ml index e51ce2df..e7bf4525 100644 --- a/src/loc.ml +++ b/src/loc.ml @@ -4,14 +4,14 @@ type t = } let of_lexbuf lb = - { start = Lexing.lexeme_start lb - ; stop = Lexing.lexeme_stop lb + { start = Lexing.lexeme_start_p lb + ; stop = Lexing.lexeme_end_p lb } exception Error of t * string let fail t fmt = - Printf.ksprintf (fun msg -> raise (File_error (t, msg))) fmt + Printf.ksprintf (fun msg -> raise (Error (t, msg))) fmt let fail_lex lb fmt = fail (of_lexbuf lb) fmt diff --git a/src/loc.mli b/src/loc.mli index c737af12..db916f5d 100644 --- a/src/loc.mli +++ b/src/loc.mli @@ -7,5 +7,5 @@ val of_lexbuf : Lexing.lexbuf -> t exception Error of t * string -val fail : t -> string -> _ -val fail_lex : Lexing.lexbuf -> string -> _ +val fail : t -> ('a, unit, string, _) format4 -> 'a +val fail_lex : Lexing.lexbuf -> ('a, unit, string, _) format4 -> 'a diff --git a/src/meta.ml b/src/meta.ml index f967a125..6064728c 100644 --- a/src/meta.ml +++ b/src/meta.ml @@ -32,7 +32,7 @@ module Parse = struct | _ -> error lb "package name expected" let string lb = - match lb with + match next lb with | String s -> s | _ -> error lb "string expected" @@ -76,8 +76,8 @@ module Parse = struct | Name "package" -> let name = package_name lb in lparen lb; - let entries = entries lb (depth + 1) [] in - entries lb depth (Package { name; entries } :: acc) + let sub_entries = entries lb (depth + 1) [] in + entries lb depth (Package { name; entries = sub_entries } :: acc) | Name var -> let preds, action = match next lb with @@ -87,7 +87,7 @@ module Parse = struct | _ -> error lb "'=', '+=' or '(' expected" in let value = string lb in - Var (var, preds, action, value) + entries lb depth (Var (var, preds, action, value) :: acc) | _ -> error lb "'package' or variable name expected" end diff --git a/src/meta_lexer.mll b/src/meta_lexer.mll index 564a766a..84998897 100644 --- a/src/meta_lexer.mll +++ b/src/meta_lexer.mll @@ -25,8 +25,8 @@ rule token = parse Buffer.contents buf else match s.[i] with - | '\\' -> Buffer.add_char s.[i + 1]; loop (i + 2) - | _ -> Buffer.add_char s.[i ]; loop (i + 1) + | '\\' -> Buffer.add_char buf s.[i + 1]; loop (i + 2) + | _ -> Buffer.add_char buf s.[i ]; loop (i + 1) in String (loop 0) } | '-' { Minus }