Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Tidying up a bit of FStar.All and FStar.Compiler.Effect #3551

Merged
merged 3 commits into from
Oct 10, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10 changes: 4 additions & 6 deletions ocaml/fstar-lib/FStar_All.ml
Original file line number Diff line number Diff line change
@@ -1,9 +1,7 @@
exception Failure = Failure
let failwith x = raise (Failure x)
let exit i = exit (Z.to_int i)
let op_Bar_Greater (x : 'a) (f : ('a -> 'b)) : 'b = f x
let op_Less_Bar (f : ('a -> 'b)) (x : 'a) : 'b = f x
let pipe_right a f = f a
let pipe_left f a = f a
let try_with f1 f2 = try f1 () with | e -> f2 e

(* Not used: handled specially by extraction. If used,
you will get all sorts of weird failures (e.g. an incomplete match
on f2!). *)
(* let try_with f1 f2 = try f1 () with | e -> f2 e *)
8 changes: 4 additions & 4 deletions ocaml/fstar-lib/FStar_Compiler_Effect.ml
Original file line number Diff line number Diff line change
@@ -1,6 +1,3 @@
let op_Bar_Greater (x : 'a) (f : ('a -> 'b)) : 'b = f x
let op_Less_Bar (f : ('a -> 'b)) (x : 'a) : 'b = f x

type 'a ref' = 'a ref[@@deriving yojson,show]
type 'a ref = 'a ref'[@@deriving yojson,show]

Expand All @@ -9,6 +6,9 @@ let op_Colon_Equals x y = x := y
let alloc x = ref x
let raise = raise
let exit i = exit (Z.to_int i)
let try_with f1 f2 = try f1 () with | e -> f2 e
exception Failure = Failure
let failwith x = raise (Failure x)
(* Not used: handled specially by extraction. If used,
you will get all sorts of weird failures (e.g. an incomplete match
on f2!). *)
(* let try_with f1 f2 = try f1 () with | e -> f2 e *)
3 changes: 1 addition & 2 deletions src/Makefile.boot
Original file line number Diff line number Diff line change
Expand Up @@ -52,8 +52,7 @@ EXTRACT_MODULES=FStar.Pervasives FStar.Common FStar.Thunk \
# And there are a few specific files that should not be extracted at
# all, despite being in one of the EXTRACT_NAMESPACES
NO_EXTRACT=FStar.Tactics.Native FStar.Tactics.Load \
FStar.Extraction.ML.PrintML FStar.Compiler.List \
FStar.Compiler.Effect
FStar.Extraction.ML.PrintML FStar.Compiler.List

EXTRACT = $(addprefix --extract_module , $(EXTRACT_MODULES)) \
$(addprefix --extract_namespace , $(EXTRACT_NAMESPACES)) \
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -37,31 +37,24 @@ effect All (a:Type) (pre:all_pre) (post:(h:unit -> Tot (all_post' a (pre h)))) =

effect ML (a:Type) = ALL a (fun (p:all_post a) (_:unit) -> forall (a:result a) (h:unit). p a h)

assume
new
val ref (a:Type) : Type0

assume
val (!) (#a:Type) (r:ref a)
: ML a

assume
val (:=) (#a:Type) (r:ref a) (x:a)
: ML unit

assume
val alloc (#a:Type) (x:a)
: ML (ref a)

assume
val raise (e: exn) : ML 'a

assume
val exit : int -> ML 'a

assume
val try_with : (unit -> ML 'a) -> (exn -> ML 'a) -> ML 'a

exception Failure of string

assume
val failwith : string -> ML 'a
8 changes: 4 additions & 4 deletions ulib/FStar.All.fst → ulib/FStar.All.fsti
Original file line number Diff line number Diff line change
Expand Up @@ -36,8 +36,8 @@ effect All (a:Type) (pre:all_pre) (post:(h:heap -> Tot (all_post' a (pre h)))) =
(fun (p : all_post a) (h : heap) -> pre h /\ (forall ra h1. post h ra h1 ==> p ra h1))
effect ML (a:Type) = ALL a (fun (p:all_post a) (_:heap) -> forall (a:result a) (h:heap). p a h)

assume val exit : int -> ML 'a
assume val try_with : (unit -> ML 'a) -> (exn -> ML 'a) -> ML 'a
val exit : int -> ML 'a
val try_with : (unit -> ML 'a) -> (exn -> ML 'a) -> ML 'a

assume exception Failure of string
assume val failwith : string -> All 'a (fun h -> True) (fun h a h' -> Err? a /\ h == h')
exception Failure of string
val failwith : string -> All 'a (fun h -> True) (fun h a h' -> Err? a /\ h == h')
2 changes: 1 addition & 1 deletion ulib/ml/Makefile.realized
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
# You should include this Makefile in your Makefile to make sure you remain
# future-proof w.r.t. realized modules!

FSTAR_REALIZED_MODULES=All Buffer Bytes Char CommonST Constructive Dyn Float Ghost Heap Monotonic.Heap \
FSTAR_REALIZED_MODULES=Buffer Bytes Char CommonST Constructive Dyn Float Ghost Heap Monotonic.Heap \
HyperStack.All HyperStack.ST HyperStack.IO Int16 Int32 Int64 Int8 IO \
List List.Tot.Base Mul Option Pervasives.Native ST Exn String \
UInt16 UInt32 UInt64 UInt8 \
Expand Down
Loading