MAJ terminée. Nous sommes passés en version 14.6.2 . Pour consulter les "releases notes" associées c'est ici :

https://about.gitlab.com/releases/2022/01/11/security-release-gitlab-14-6-2-released/
https://about.gitlab.com/releases/2022/01/04/gitlab-14-6-1-released/

Commit 9f3d73ac authored by charguer's avatar charguer
Browse files

primitives

parent 58cfc3c9
let make = Primitives.array_make
let length = Primitives.array_length
let get = Primitives.array_get
let set = Primitives.array_set
let init n f =
assert (n >= 0);
if n = 0 then [||] else begin
let res = create n (f 0) in
for i = 1 to pred n do
unsafe_set res i (f i)
done;
res
end
(* Remark: might be optimized by using a sub-array to avoid initialization *)
let fill a start nb v =
assert (not (start < 0 || nb < 0 || start > length a - nb));
for i = start to pred (start + nb) do
a.(i) <- v;
done
let blit a1 start1 a2 start2 nb =
assert (not (nb < 0 || start1 < 0 || start1 > length a1 - nb
|| start2 < 0 || start2 > length a2 - nb));
for i = 0 to pred nb do
a2.(start2 + i) <- a1.(start1 + i);
done
let append a1 a2 =
let n1 = length a1 in
let n2 = length a2 in
if n1 = 0 && n2 = 0 then [||] else begin
let d = (if n1 <> 0 then a1.(0) else a2.(0)) in
let a = make (n1+n2) d in
for i = 0 to pred n1 do
a.(i) <- a1.(i);
done;
for i = 0 to pred n2 do
a.(n1+i) <- a2.(i)
done;
end
(* Remark: might be optimized by using a sub-array to avoid initialization *)
let iter f a =
for i = 0 to pred (length a) do
f a.(i)
done
let iteri f a =
for i = 0 to pred (length a) do
f i a.(i)
done
let map f a =
let n = length a in
if n = 0 then [||] else begin
let r = make n (f a.(0)) in
for i = 1 to pred n do
r.(i) <- f a.(i);
done;
r
end
(* Remark: might be optimized by using a sub-array to avoid initialization *)
let mapi f a =
let n = length a in
if n = 0 then [||] else begin
let r = make n (f 0 a.(0)) in
for i = 1 to pred n do
r.(i) <- f i a.(i);
done;
r
end
(* Remark: might be optimized by using a sub-array to avoid initialization *)
let fold_left f x a =
let r = ref x in
for i = 0 to pred (length a) do
r := f !r a.(i)
done;
!r
let fold_right f a x =
let r = ref x in
for i = pred (length a) downto 0 do
r := f a.(i) !r
done;
!r
(* INCLUDE?
let hd = function
| [] -> assert false
| a::l -> a
let tl = function
| [] -> assert false
| a::l -> l
*)
let length l =
let rec aux len = function
| [] -> len
| a::l -> length_aux (len + 1) l
in
aux 0 l
let nth l n =
assert (n >= 0);
let rec aux l n =
match l with
| [] -> assert false
| a::l -> if n = 0 then a else aux l (n - 1)
in
aux l n
let append l1 l2 =
let rec aux = function
| [] -> l2
| a::l -> a::(aux l)
in
aux l1
let (@) = append
let rec rev_append l1 l2 =
match l1 with
| [] -> l2
| a :: l -> rev_append l (a :: l2)
let rev l =
rev_append l []
let rec concat = function
| [] -> []
| l::r -> l @ flatten r
let rec iter f = function
| [] -> ()
| a::l -> f a; iter f l
let iteri f l =
let rec aux i = function
| [] -> ()
| a::l -> f i a; aux (i + 1) l
in
aux 0 l
let rec map f = function
| [] -> []
| a::l ->
let r = f a in
r :: map f l
let mapi f l =
let rec aux i = function
| [] -> []
| a::l ->
let r = f i a in
r :: aux (i + 1) l
in
mapi 0 f l
(* USEFUL?
let rev_map f l =
let rec rmap_f acc = function
| [] -> acc
| a::l -> rmap_f (f a :: acc) l
in
rmap_f [] l
*)
let rec fold_left f acc l =
match l with
| [] -> acc
| a::l -> fold_left f (f acc a) l
let rec fold_right f l acc =
match l with
| [] -> acc
| a::l -> f a (fold_right f l acc)
let rec for_all p = function
| [] -> true
| a::l -> p a && for_all p l
let rec exists p = function
| [] -> false
| a::l -> p a || exists p l
exception Find_not_found
let rec find p = function
| [] -> raise Find_not_found
| a::l -> if p a then a else find p l
let filter p l =
let rec aux acc = function
| [] -> rev acc
| a::l -> if p a then aux (a::acc) l else find acc l
in
aux [] l
let partition p l =
let rec aux yes no = function
| [] -> (rev yes, rev no)
| x :: l ->
if p x
then aux (x :: yes) no l
else aux yes (x :: no) l
in
aux [] [] l
let rec split = function
| [] -> ([], [])
| (x,y)::l ->
let (rx, ry) = split l in
(x::rx, y::ry)
let rec combine l1 l2 =
match (l1, l2) with
| ([], []) -> []
| (a1::l1, a2::l2) -> (a1, a2) :: (combine l1 l2)
| (_, _) -> assert false
let take n l =
assert (n >= 0);
let rec aux n l =
if n = 0 then [] else begin
match l with
| [] -> assert false
| a::l -> a::(aux (n-1) l) in
end
in
aux n l
let drop n l =
assert (n >= 0);
let rec aux n l =
if n = 0 then l else begin
match l with
| [] -> assert false
| a::l -> aux (n-1) l in
end
in
aux n l
let split_at n l =
assert (n >= 0);
let rec aux n l =
if n = 0 then ([], l) else begin
match l with
| [] -> assert false
| a::l ->
let (l1,l2) = aux (n-1) l in
(a::l1,l2)
end
in
aux n l
(************************************************************)
(* LATER move into List2 module
let rec for_all2 p l1 l2 =
match (l1, l2) with
([], []) -> true
| (a1::l1, a2::l2) -> p a1 a2 && for_all2 p l1 l2
| (_, _) -> invalid_arg "List.for_all2"
let rec exists2 p l1 l2 =
match (l1, l2) with
([], []) -> false
| (a1::l1, a2::l2) -> p a1 a2 || exists2 p l1 l2
| (_, _) -> invalid_arg "List.exists2"
let rec map2 f l1 l2 =
match (l1, l2) with
([], []) -> []
| (a1::l1, a2::l2) -> let r = f a1 a2 in r :: map2 f l1 l2
| (_, _) -> invalid_arg "List.map2"
let rev_map2 f l1 l2 =
let rec rmap2_f acc l1 l2 =
match (l1, l2) with
| ([], []) -> acc
| (a1::l1, a2::l2) -> rmap2_f (f a1 a2 :: acc) l1 l2
| (_, _) -> invalid_arg "List.rev_map2"
in
rmap2_f [] l1 l2
;;
let rec iter2 f l1 l2 =
match (l1, l2) with
([], []) -> ()
| (a1::l1, a2::l2) -> f a1 a2; iter2 f l1 l2
| (_, _) -> invalid_arg "List.iter2"
let rec fold_left2 f acc l1 l2 =
match (l1, l2) with
([], []) -> acc
| (a1::l1, a2::l2) -> fold_left2 f (f acc a1 a2) l1 l2
| (_, _) -> invalid_arg "List.fold_left2"
let rec fold_right2 f l1 l2 acc =
match (l1, l2) with
([], []) -> acc
| (a1::l1, a2::l2) -> f a1 a2 (fold_right2 f l1 l2 acc)
| (_, _) -> invalid_arg "List.fold_right2"
*)
(************************************************************)
(** LATER, into some other file Stacks *)
(*
Module Stack_ml.
Definition t (A:Type) := loc.
End Stack_ml.
Parameter ml_stack_create : func.
Parameter ml_stack_is_empty : func.
Parameter ml_stack_push : func.
Parameter ml_stack_pop : func.
*)
(* should export Primitives.mli *)
(************************************************************)
(** Physical equality *)
let (!==) x y =
not (x == y)
(************************************************************)
(** Comparison *)
let min x y =
if x <= y then x else y
let max x y =
if x >= y then x else y
(************************************************************)
(** References *)
type 'a ref = { mutable contents : 'a }
let ref x =
{ contents = x }
let (!) r =
r.contents
let (:=) r x =
r.contents <- x
let incr r =
r := !r + 1
let decr r =
r := !r - 1
(** [ref_free r] is a logical free operation, useful for translating
to languages without garbage collection *)
let ref_free r =
()
(** [ref_unsafe_set r x] allows to modifies the contents of a reference *)
let ref_unsafe_set r x =
r.contents <- (magic x)
(************************************************************)
(** Boolean *)
let not x =
if x then false else true
(************************************************************)
(** Arithmetic *)
let succ n =
n + 1
let pred n =
n - 1
let abs x =
if x >= 0 then x else -x
(************************************************************)
(** Pairs *)
let fst (x,y) =
x
let snd (x,y) =
y
(************************************************************)
(** Unit *)
let ignore x =
()
(************************************************************)
(** Type conversion *)
external magic : 'a -> 'b = "%magic"
(************************************************************)
(** Physical equality *)
external ( == ) : 'a -> 'a -> bool = "%phy_eq"
(************************************************************)
(** Comparison *)
external ( = ) : 'a -> 'a -> bool = "%equal"
external ( <> ) : 'a -> 'a -> bool = "%notequal"
external ( < ) : 'a -> 'a -> bool = "%lessthan"
external ( > ) : 'a -> 'a -> bool = "%greaterthan"
external ( <= ) : 'a -> 'a -> bool = "%lessequal"
external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
(************************************************************)
(** Boolean *)
external ( && ) : bool -> bool -> bool = "%bool_and"
external ( || ) : bool -> bool -> bool = "%bool_or"
(************************************************************)
(** Integer *)
external ( ~- ) : int -> int = "%int_neg"
external ( + ) : int -> int -> int = "%int_add"
external ( - ) : int -> int -> int = "%int_sub"
external ( * ) : int -> int -> int = "%int_mul"
external ( / ) : int -> int -> int = "%int_div"
external ( mod ) : int -> int -> int = "%int_mod"
(************************************************************)
(** Arrays *)
external array_make : int -> 'a -> 'a array = "%array_make"
external array_length : 'a array -> int = "%array_length"
external array_get : 'a array -> int -> 'a = "%array_get"
external array_set : 'a array -> int -> 'a -> unit = "%array_set"
(************************************************************)
(** IO *)
(*
Parameter stdin : loc.
Parameter stdout : loc.
Parameter ml_read_int : func.
Parameter ml_print_int : func.
*)
(************************************************************)
(** Type conversion *)
val magic : 'a -> 'b
(************************************************************)
(** Physical equality *)
val ( == ) : 'a -> 'a -> bool
(************************************************************)
(** Comparison *)
val ( = ) : 'a -> 'a -> bool
val ( <> ) : 'a -> 'a -> bool
val ( < ) : 'a -> 'a -> bool
val ( > ) : 'a -> 'a -> bool
val ( <= ) : 'a -> 'a -> bool
val ( >= ) : 'a -> 'a -> bool
(************************************************************)
(** Boolean *)
val ( && ) : bool -> bool -> bool
val ( || ) : bool -> bool -> bool
(************************************************************)
(** Integer *)
val ( ~- ) : int -> int
val ( + ) : int -> int -> int
val ( - ) : int -> int -> int
val ( * ) : int -> int -> int
val ( / ) : int -> int -> int
val ( mod ) : int -> int -> int
(************************************************************)
(** Arrays *)
val array_make : int -> 'a -> 'a array
val array_length : 'a array -> int
val array_get : 'a array -> int -> 'a
val array_set : 'a array -> int -> 'a -> unit
......@@ -6,7 +6,6 @@ Open Local Scope heap_scope_advanced.
Hint Extern 1 (_ ===> _) => apply rel_le_refl.
(********************************************************************)
(* ** Overview *)
......@@ -270,6 +269,7 @@ Proof using.
applys App_wgframe L. hsimpl. hchange R3. hsimpl. }
Qed.
Hint Resolve App_local.
(********************************************************************)
......@@ -376,501 +376,3 @@ Proof using.
Qed.
(********************************************************************)
(********************************************************************)
(********************************************************************)
(********************************************************************)
(********************************************************************)
(* DEPRECATED *)
(* bug...
Axiom App : forall (f:func) (xs:list dynamic) B (H:hprop) (Q:B->hprop), Prop.
Implicit Arguments App [[B]].
Print App.
Arguments App f%heap_scope xs%arglist H%heap_scope Q%heap_scope.
*)
(* TODO: why not
Coercion id (P:Prop) : hprop := \[P].
Error: Sortclass cannot be a source class.
*)
(*
Inductive arglist : nat -> Type :=
| arglist_nil : arglist 0
| arglist_cons : forall A (x:A) n, arglist n -> arglist (S n).
Fixpoint app (n : nat) (X : arglist n) (f:func) (B:Type) (H:hprop) (Q:B->hprop) :=
match X with
| arglist_nil => False