struct: analyzer_rw: add GT show to types

This commit is contained in:
ProgramSnail 2026-05-21 11:15:59 +00:00
parent a82ff74663
commit 98d3d56a13

View file

@ -1,35 +1,48 @@
module Functional = module Functional =
struct struct
open GT
type data = int type data = int
[@@deriving gt ~options:{ show }]
type memid = int type memid = int
[@@deriving gt ~options:{ show }]
(* --- syntax --- *) (* --- syntax --- *)
type read_cap = Rd | NRd | UndefRd type read_cap = Rd | NRd | UndefRd
[@@deriving gt ~options:{ show }]
type write_cap = AlwaysWr | MayWr | NeverWr | UndefWr type write_cap = AlwaysWr | MayWr | NeverWr | UndefWr
[@@deriving gt ~options:{ show }]
type copy_cap = Cp | Rf type copy_cap = Cp | Rf
[@@deriving gt ~options:{ show }]
type in_cap = In | NIn type in_cap = In | NIn
[@@deriving gt ~options:{ show }]
type out_cap = Out | NOut type out_cap = Out | NOut
[@@deriving gt ~options:{ show }]
type mode = in_cap * out_cap type mode = in_cap * out_cap
[@@deriving gt ~options:{ show }]
type path = VarP of data | DerefP of path | AccessP of path * data type path = VarP of data | DerefP of path | AccessP of path * data
[@@deriving gt ~options:{ show }]
type atype = UnitT of read_cap * write_cap type atype = UnitT of read_cap * write_cap
| RefT of copy_cap * atype | RefT of copy_cap * atype
| TupleT of atype list | TupleT of atype list
| FunT of (mode * atype) list (* TODO: declaration id for ease of impl / performance instead (?) *) | FunT of (mode * atype) list (* TODO: declaration id for ease of impl / performance instead (?) *)
[@@deriving gt ~options:{ show }]
type mtype = mode * atype type mtype = mode * atype
[@@deriving gt ~options:{ show }]
type expr = UnitE type expr = UnitE
| PathE of path | PathE of path
(* TODO: extend to include arbitrary path *) (* TODO: extend to include arbitrary path *)
| RefE of data | RefE of data
| TupleE of expr list | TupleE of expr list
[@@deriving gt ~options:{ show }]
type stmt = SkipS type stmt = SkipS
| CallS of path * expr list | CallS of path * expr list
@ -37,11 +50,14 @@ struct
| ReadS of path | ReadS of path
| SeqS of stmt * stmt | SeqS of stmt * stmt
| ChoiceS of stmt * stmt | ChoiceS of stmt * stmt
[@@deriving gt ~options:{ show }]
type decl = VarD of (* data * *) atype (* * expr *) type decl = VarD of (* data * *) atype (* * expr *)
| FunD of (* data * *) (* (data * *) mtype (* ) *) list * stmt | FunD of (* data * *) (* (data * *) mtype (* ) *) list * stmt
[@@deriving gt ~options:{ show }]
type prog = decl list * stmt type prog = decl list * stmt
[@@deriving gt ~options:{ show }]
(* --- exceptions --- *) (* --- exceptions --- *)
@ -68,26 +84,36 @@ struct
(* | TupleDV of deepvalue list *) (* | TupleDV of deepvalue list *)
type memval = ZeroMV | SmthMV | BotMV (* | TopMV ?? *) type memval = ZeroMV | SmthMV | BotMV (* | TopMV ?? *)
[@@deriving gt ~options:{ show }]
type readval = ZeroRV | OneRV | TopRV type readval = ZeroRV | OneRV | TopRV
[@@deriving gt ~options:{ show }]
type writeval = ZeroWV | SmthWV | OneWV type writeval = ZeroWV | SmthWV | OneWV
[@@deriving gt ~options:{ show }]
type value = UnitV of memval * readval * writeval type value = UnitV of memval * readval * writeval
| FunV (* of ((* data list * *) stmt) list *) | FunV (* of ((* data list * *) stmt) list *)
| RefV of memid | RefV of memid
| TupleV of value list | TupleV of value list
[@@deriving gt ~options:{ show }]
type revpath = VarRP | DerefRP of revpath | AccessRP of revpath * data type revpath = VarRP | DerefRP of revpath | AccessRP of revpath * data
[@@deriving gt ~options:{ show }]
type action = ReadA | AlwaysWriteA | MayWriteA type action = ReadA | AlwaysWriteA | MayWriteA
[@@deriving gt ~options:{ show }]
(* TODO: any additional difference between rvalue and lvalue now ?? *) (* TODO: any additional difference between rvalue and lvalue now ?? *)
(* --- *) (* --- *)
type mem = value list * memid (* NOTE: memory and first free elem *) type mem = value list * memid (* NOTE: memory and first free elem *)
[@@deriving gt ~options:{ show }]
type types = (data * atype) list type types = (data * atype) list
[@@deriving gt ~options:{ show }]
type vals = (data * memid) list type vals = (data * memid) list
[@@deriving gt ~options:{ show }]
type state = mem * types * vals type state = mem * types * vals
[@@deriving gt ~options:{ show }]
(* --- *) (* --- *)