package mopsa

  1. Overview
  2. Docs
package mopsa
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file Clang_parser_cache.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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
(****************************************************************************)
(*                                                                          *)
(* This file is part of MOPSA, a Modular Open Platform for Static Analysis. *)
(*                                                                          *)
(* Copyright (C) 2017-2019 The MOPSA Project.                               *)
(*                                                                          *)
(* This program is free software: 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, either version 3 of the License, or     *)
(* (at your option) any later version.                                      *)
(*                                                                          *)
(* This program 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.                      *)
(*                                                                          *)
(* You should have received a copy of the GNU Lesser General Public License *)
(* along with this program.  If not, see <http://www.gnu.org/licenses/>.    *)
(*                                                                          *)
(****************************************************************************)


(**
  Clang_parser_cache - Cache parsed AST to improve efficiency.

  AST are cached in marshalized files.
  We store the list of files used during parsing and check that they
  have not been modified before using the cache.
 *)



open Clang_AST
open Clang_parser


let debug fmt = Mopsa_utils.Debug.debug ~channel:"c.parser_cache" fmt

(** Version number. 
    This is checked when using the cache, and should be changed when
    the signature or the AST type change to invalidate the cache.
*)
let version = "Mopsa.C.AST/1"

       
(** Source file identification. *)
type file_signature =
    string   (* absolute filename *)
    * float  (* last modification time *)
    * int    (* length *)

        
(** Parse identification. *)
type signature =
    string                  (* parser command *)
    * target_options        (* target *)
    * string array          (* parser arguments *)
    * file_signature list   (* file names and timestamp *)


                     
(** Make filename absolute. *)
let file_abs f =
(*  if Filename.is_relative f then Filename.concat (Sys.getcwd ()) f
  else*) f

         
let get_file_signature (f:string) : file_signature =
  let f = file_abs f in
  let s = Unix.stat f in
  f, s.Unix.st_mtime, s.Unix.st_size

                        
let get_signature cmd tgt opts files : signature =
  cmd, tgt, opts, List.map get_file_signature files

                           
(** Checks that the signature is valid. *)    
let check_signature cmd tgt opts signature : bool =
  let cmd', tgt', opts', files' = signature in
  cmd = cmd' && tgt = tgt' && opts = opts' &&
  (List.for_all (fun s -> let f,_,_ = s in get_file_signature f = s) files')

    
(** File name of cache for a given source file name. *)
let file_cache_name file =
   file ^ ".mopsa_ast" 

    
(** Drop-in replacement to [Clang_parser.cache], but uses a cache on disk. *)
let parse cmd tgt file opts : parse_result =

  debug "Clang_parser_cache: parsing %s" file;
      
  (* try to read cache *)
  let file_cache = file_cache_name file in
  debug "Clang_parser_cache: looking for cache file %s" file_cache;
  let from_cache : parse_result option =
    try
      (* try cache file *)
      let f = Unix.openfile file_cache [Unix.O_RDWR] 0o666 in
      Unix.lockf f F_LOCK 0;
      let cache = Unix.in_channel_of_descr f in
      let v = Marshal.from_channel cache in
      let r = 
        if v <> version then (
          debug "Clang_parser_cache: %s incompatible version" file_cache;
          None
        )
        else
          let signature : signature = Marshal.from_channel cache in
          let check =
            try check_signature cmd tgt opts signature with _ -> false
          in
          if check then  (
            (* correct signature -> use cache *)
            debug "Clang_parser_cache: %s found" file_cache;
            Some (Marshal.from_channel cache)
          )
          else (
            (* incorrect signature *)
            debug "Clang_parser_cache: %s incompatible signature" file_cache;
            None
          )
      in
      ignore (Unix.lseek f 0 SEEK_SET);
      Unix.lockf f F_ULOCK 0;
      close_in cache;
      r
    with _ ->
      (* cache file not available *)
      debug "Clang_parser_cache: %s cache file not found" file_cache;
      None 
  in
  
  match from_cache with
  | Some c -> c
  | None ->
     (* parse *)
     let r = Clang_parser.parse ~command:cmd ~target:tgt ~filename:file ~args:opts in
     let files = List.sort compare r.parse_files in
     let files = List.filter (fun x -> x <> "<built-in>") files in
     let c = get_signature cmd tgt opts files in
     (* store signature & parse result *)
     debug "Clang_parser_cache: storing cache to %s" file_cache;

     let f = Unix.openfile file_cache [Unix.O_WRONLY;Unix.O_CREAT;Unix.O_TRUNC] 0o666 in
     let cache = Unix.out_channel_of_descr f in
     Unix.lockf f F_LOCK 0;
     Marshal.to_channel cache version [];
     Marshal.to_channel cache c [];
     Marshal.to_channel cache r [];
     flush cache;
     ignore (Unix.lseek f 0 SEEK_SET);
     Unix.lockf f F_ULOCK 0;
     close_out cache;
     r

let parse cmd tgt enable_cache file opts =
  if enable_cache then parse cmd tgt file opts
  else Clang_parser.parse ~command:cmd ~target:tgt ~filename:file ~args:opts
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