package frama-c

  1. Overview
  2. Docs
package frama-c
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file mt_lib.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
(**************************************************************************)
(*                                                                        *)
(*  This file is part of Frama-C.                                         *)
(*                                                                        *)
(*  Copyright (C) 2007-2025                                               *)
(*    CEA (Commissariat à l'énergie atomique et aux énergies              *)
(*         alternatives)                                                  *)
(*                                                                        *)
(*  you can redistribute it and/or modify it under the terms of the GNU   *)
(*  Lesser General Public License as published by the Free Software       *)
(*  Foundation, version 2.1.                                              *)
(*                                                                        *)
(*  It is distributed in the hope that it will be useful,                 *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *)
(*  GNU Lesser General Public License for more details.                   *)
(*                                                                        *)
(*  See the GNU Lesser General Public License version 2.1                 *)
(*  for more details (enclosed in the file licenses/LGPLv2.1).            *)
(*                                                                        *)
(**************************************************************************)

(** {1 Auxiliary definitions and functions for pretty-printing } *)

(** Partially applied format-like function missing a "%a" argument *)
type poly_format_quote_a =
  { pf: 'a. (Format.formatter -> 'a -> unit) -> 'a -> unit }

(** Partially applied Log.pretty_printer value, missing its entire formatter
    (and the arguments) *)
type poly_pretty_printer =
  { ppp: 'a. ('a, Format.formatter, unit) format -> 'a }


let compare_tag (v1 : 'a) (v2 : 'a) =
  let o1 = Obj.repr v1 and o2 = Obj.repr v2 in
  match Obj.is_int o1, Obj.is_int o2 with
  | true, true -> Stdlib.compare o1 o2
  | false, false -> Stdlib.compare (Obj.tag o1) (Obj.tag o2)
  | true, false -> 1
  | false, true -> -1

let comp f1 v11 v12 f2 v21 v22 =
  let r = f1 v11 v12 in
  if r = 0 then f2 v21 v22 else r


(* -------------------------------------------------------------------------- *)
(* --- Misc                                                               --- *)
(* -------------------------------------------------------------------------- *)

type 'a conversion_with_warning = [
  | `Success of 'a
  | `WithWarning of (Format.formatter -> unit) * 'a
]

type 'a conversion = [
  | 'a conversion_with_warning
  | `Failure of (Format.formatter -> unit)
]


exception Found of int

let utf8_char_length c =
  if c < 0x80 then 1
  else
    try
      let mask = ref 0b10000000 in
      for i = 1 to 8 do
        mask := !mask lor (1 lsl (8-i));
        if (c land !mask) = !mask then
          raise (Found (i+1))
      done;
      failwith (Format.sprintf "incorrect utf-8 start %d" c)
    with Found i -> i

(*if c < 0b11100000 then 2
  else if c < 0b11110000 then 3
  else if c < 0b11111000 then 4
  else if c < 0b11111100 then 5
  else 6
*)

exception Escape_non_utf8 of string * int * int

let escape_char c =
  if c = '"' then "\\\""
  else Char.escaped c

let escape_non_utf8 s =
  let s' = Buffer.create (String.length s) in
  let rec aux i =
    if i < String.length s then
      let c = s.[i] in
      let utf8 = utf8_char_length (Char.code c) in
      if utf8 <> 1 then
        try
          let sub = String.sub s i utf8 in
          Buffer.add_string s' sub;
          aux (i+utf8)
        with _ -> raise (Escape_non_utf8 (s, i, utf8))
      else (
        Buffer.add_string s' (escape_char c);
        aux (i+1)
      )
  in
  aux 0;
  Buffer.contents s'


let clear_value_results () =
  Project.clear ~selection:(State_selection.with_dependencies
                              Analysis.self) ();
;;

let mthread_h () =
  Mt_options.MThread.Share.get_file "mthread.h";;


let sanitize_filename ?(char='_') s =
  let is_invalid c =
    match c with
    | '&' | '+' | '[' | ']' | '.' -> true
    | _ -> false
  in
  String.map (fun c -> if is_invalid c then char else c) s
OCaml

Innovation. Community. Security.

GitHub Discord Twitter Peertube RSS
About
Changelog Releases Industrial Users Academic Users Why OCaml
Ecosystem
Packages Community Events OCaml Planet Jobs
Resources
Install OCaml Get Started Platform Tools Language Manual Standard Library API Books Exercises Papers OCaml Playground Logo
Policies
Carbon Footprint Governance Privacy Code of Conduct