source: extracted/aSMCostsSplit.ml @ 2993

Last change on this file since 2993 was 2993, checked in by sacerdot, 7 years ago
  1. performance improved: the type inference was inferring load_code_memory ... in computational positions, duplicating the work at every step of execution of the assembly code. We now force the use of the let-in-ed variable
  2. new extraction after 1)
  3. driver/printer.ml repaired
  4. the output of the intermediate passes is now printed on file
File size: 3.2 KB
Line 
1open Preamble
2
3open Fetch
4
5open Hide
6
7open Division
8
9open Z
10
11open BitVectorZ
12
13open Pointers
14
15open Coqlib
16
17open Values
18
19open Events
20
21open IOMonad
22
23open IO
24
25open Sets
26
27open Listb
28
29open StructuredTraces
30
31open AbstractStatus
32
33open BitVectorTrie
34
35open String
36
37open Exp
38
39open Arithmetic
40
41open Vector
42
43open FoldStuff
44
45open BitVector
46
47open Extranat
48
49open Integers
50
51open AST
52
53open LabelledObjects
54
55open Proper
56
57open PositiveMap
58
59open Deqsets
60
61open ErrorMessages
62
63open PreIdentifiers
64
65open Errors
66
67open Extralib
68
69open Setoids
70
71open Monad
72
73open Option
74
75open Div_and_mod
76
77open Jmeq
78
79open Russell
80
81open Util
82
83open List
84
85open Lists
86
87open Bool
88
89open Relations
90
91open Nat
92
93open Positive
94
95open Hints_declaration
96
97open Core_notation
98
99open Pts
100
101open Logic
102
103open Types
104
105open Identifiers
106
107open CostLabel
108
109open ASM
110
111open Status
112
113open StatusProofs
114
115open Interpret
116
117open ASMCosts
118
119open UtilBranch
120
121(** val traverse_code_internal :
122    ASM.labelled_object_code -> BitVector.word -> Nat.nat -> Nat.nat
123    Identifiers.identifier_map Types.sig0 **)
124let rec traverse_code_internal prog program_counter program_size =
125  (match program_size with
126   | 0 -> (fun _ -> Identifiers.empty_map PreIdentifiers.CostTag)
127   | _ -> let program_size' = program_size - 1 in
128     (fun _ ->
129       let new_program_counter' =
130         Arithmetic.add (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
131           (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
132           Nat.O))))))))))))))))
133           (Arithmetic.bitvector_of_nat (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
134             (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
135             (Nat.S (Nat.S Nat.O)))))))))))))))) (Nat.S Nat.O))
136           program_counter
137       in
138       let cost_mapping =
139         traverse_code_internal prog new_program_counter' program_size'
140       in
141       (match BitVectorTrie.lookup_opt (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
142                (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
143                (Nat.S (Nat.S (Nat.S Nat.O)))))))))))))))) program_counter
144                prog.ASM.costlabels with
145        | Types.None -> (fun _ -> Types.pi1 cost_mapping)
146        | Types.Some lbl ->
147          (fun _ ->
148            let cost = ASMCosts.block_cost prog program_counter in
149            Identifiers.add PreIdentifiers.CostTag (Types.pi1 cost_mapping)
150              lbl (Types.pi1 cost))) __)) __
151
152(** val traverse_code :
153    ASM.labelled_object_code -> Nat.nat Identifiers.identifier_map Types.sig0 **)
154let traverse_code prog =
155  Types.pi1
156    (traverse_code_internal prog
157      (BitVector.zero (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
158        (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S
159        Nat.O)))))))))))))))))
160      (Glue.int_of_matitanat (List.length (ASM.oc prog))))
161
162(** val compute_costs :
163    ASM.labelled_object_code -> Nat.nat Identifiers.identifier_map Types.sig0 **)
164let compute_costs =
165  traverse_code
166
167(** val aSM_cost_map :
168    ASM.labelled_object_code -> StructuredTraces.as_cost_map **)
169let aSM_cost_map p =
170  let cost_map = compute_costs p in
171  (fun l_sig ->
172  Identifiers.lookup_present PreIdentifiers.CostTag (Types.pi1 cost_map)
173    (StructuredTraces.as_cost_get_label (ASMCosts.oC_abstract_status p)
174      l_sig))
175
Note: See TracBrowser for help on using the repository browser.