[hcoop/debian/mlton.git] / mlton / backend / rssa.sig

(* Copyright (C) 2009,2017 Matthew Fluet.
 * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
 *    Jagannathan, and Stephen Weeks.
 * Copyright (C) 1997-2000 NEC Research Institute.
 *
 * MLton is released under a BSD-style license.
 * See the file MLton-LICENSE for details.
 *)

signature RSSA_STRUCTS = 
   sig
      include ATOMS

      structure Handler: HANDLER
      structure ObjectType: OBJECT_TYPE
      structure ObjptrTycon: OBJPTR_TYCON
      structure Return: RETURN
      structure Runtime: RUNTIME
      structure Scale: SCALE
      structure Type: REP_TYPE

      sharing Atoms = Type
      sharing Handler = Return.Handler
      sharing Label = Handler.Label = Return.Label
      sharing ObjectType = Type.ObjectType
      sharing ObjptrTycon = ObjectType.ObjptrTycon = Type.ObjptrTycon
      sharing Runtime = Type.Runtime
      sharing Scale = Type.Scale
   end

signature RSSA = 
   sig
      include RSSA_STRUCTS

      structure Switch: SWITCH
      sharing Atoms = Switch

      structure Operand:
         sig
            datatype t =
               ArrayOffset of {base: t,
                               index: t,
                               offset: Bytes.t,
                               scale: Scale.t,
                               ty: Type.t}
             | Cast of t * Type.t
             | Const of Const.t
               (* EnsuresBytesFree is a pseudo-op used by C functions (like
                * GC_allocateArray) that take a number of bytes as an argument
                * and ensure that that number of bytes is free upon return.
                * EnsuresBytesFree is replaced by the limit check pass with
                * a real operand.
                *)
             | EnsuresBytesFree
             | GCState
             | Offset of {base: t,
                          offset: Bytes.t,
                          ty: Type.t}
             | ObjptrTycon of ObjptrTycon.t
             | Runtime of Runtime.GCField.t
             | Var of {ty: Type.t,
                       var: Var.t}

            val bool: bool -> t
            val cast: t * Type.t -> t
            val layout: t -> Layout.t
            val null: t
            val replaceVar: t * (Var.t -> t) -> t
            val ty: t -> Type.t
            val word: WordX.t -> t
            val zero: WordSize.t -> t
         end
      sharing Operand = Switch.Use

      structure Statement:
         sig
            datatype t =
               Bind of {dst: Var.t * Type.t,
                        isMutable: bool,
                        src: Operand.t}
             | Move of {dst: Operand.t,
                        src: Operand.t}
             | Object of {dst: Var.t * Type.t,
                          header: word,
                          size: Bytes.t (* including header *)}
             | PrimApp of {args: Operand.t vector,
                           dst: (Var.t * Type.t) option,
                           prim: Type.t Prim.t}
             | Profile of ProfileExp.t
             | ProfileLabel of ProfileLabel.t
             | SetExnStackLocal
             | SetExnStackSlot
             | SetHandler of Label.t (* label must be of Handler kind. *)
             | SetSlotExnStack

            (* foldDef (s, a, f)
             * If s defines a variable x, then return f (x, a), else return a.
             *)
            val foldDef: t * 'a * (Var.t * Type.t * 'a -> 'a) -> 'a
            (* foreachDef (s, f) = foldDef (s, (), fn (x, ()) => f x) *)
            val foreachDef: t * (Var.t * Type.t -> unit) -> unit
            val foreachDefUse: t * {def: (Var.t * Type.t) -> unit,
                                    use: Var.t -> unit} -> unit
            val foldUse: t * 'a * (Var.t * 'a -> 'a) -> 'a
            val foreachUse: t * (Var.t -> unit) -> unit
            val layout: t -> Layout.t
            val replaceUses: t * (Var.t -> Operand.t) -> t
            val resize: Operand.t * Type.t -> Operand.t * t list
            val toString: t -> string
         end

      structure Transfer:
         sig
            datatype t =
               Arith of {args: Operand.t vector,
                         dst: Var.t,
                         overflow: Label.t, (* Must be nullary. *)
                         prim: Type.t Prim.t,
                         success: Label.t, (* Must be nullary. *)
                         ty: Type.t}
             | CCall of {args: Operand.t vector,
                         func: Type.t CFunction.t,
                         (* return is NONE iff the CFunction doesn't return.
                          * Else, return must be SOME l, where l is of kind
                          * CReturn.  The return should be nullary if the C
                          * function returns void.  Else, it should be unary with
                          * a var of the appropriate type to accept the result.
                          *)
                         return: Label.t option}
             | Call of {args: Operand.t vector,
                        func: Func.t,
                        return: Return.t}
             | Goto of {args: Operand.t vector,
                        dst: Label.t}
             (* Raise implicitly raises to the caller.  
              * I.E. the local handler stack must be empty.
              *)
             | Raise of Operand.t vector
             | Return of Operand.t vector
             | Switch of Switch.t

            val bug: unit -> t
            (* foldDef (t, a, f)
             * If t defines a variable x, then return f (x, a), else return a.
             *)
            val foldDef: t * 'a * (Var.t * Type.t * 'a -> 'a) -> 'a
            (* foreachDef (t, f) = foldDef (t, (), fn (x, ()) => f x) *)
            val foreachDef: t * (Var.t * Type.t -> unit) -> unit
            val foreachDefLabelUse: t * {def: Var.t * Type.t -> unit,
                                         label: Label.t -> unit,
                                         use: Var.t -> unit} -> unit
            val foreachFunc: t * (Func.t -> unit) -> unit
            val foreachLabel: t * (Label.t -> unit) -> unit
            val foreachUse: t * (Var.t -> unit) -> unit
            val ifBool: Operand.t * {falsee: Label.t, truee: Label.t} -> t
            (* in ifZero, the operand should be of type defaultWord *)
            val ifZero: Operand.t * {falsee: Label.t, truee: Label.t} -> t
            val layout: t -> Layout.t
            val replaceUses: t * (Var.t -> Operand.t) -> t
         end

      structure Kind:
         sig
            datatype t =
               Cont of {handler: Handler.t}
             | CReturn of {func: Type.t CFunction.t}
             | Handler
             | Jump

            datatype frameStyle = None | OffsetsAndSize | SizeOnly
            val frameStyle: t -> frameStyle
         end

      structure Block:
         sig
            datatype t =
               T of {args: (Var.t * Type.t) vector,
                     kind: Kind.t,
                     label: Label.t,
                     statements: Statement.t vector,
                     transfer: Transfer.t}

            val clear: t -> unit
            val kind: t -> Kind.t
            val label: t -> Label.t
            val layout: t -> Layout.t
         end

      structure Function:
         sig
            type t

            val blocks: t -> Block.t vector
            val clear: t -> unit
            val dest: t -> {args: (Var.t * Type.t) vector,
                            blocks: Block.t vector,
                            name: Func.t,
                            raises: Type.t vector option,
                            returns: Type.t vector option,
                            start: Label.t}
            (* dfs (f, v) visits the blocks in depth-first order, applying v b
             * for block b to yield v', then visiting b's descendents,
             * then applying v' ().
             *)
            val dfs: t * (Block.t -> unit -> unit) -> unit
            val foreachDef: t * (Var.t * Type.t -> unit) -> unit
            val foreachUse: t * (Var.t -> unit) -> unit
            val name: t -> Func.t
            val new: {args: (Var.t * Type.t) vector,
                      blocks: Block.t vector,
                      name: Func.t,
                      raises: Type.t vector option,
                      returns: Type.t vector option,
                      start: Label.t} -> t
         end

      structure Program:
         sig
            datatype t =
               T of {functions: Function.t list,
                     handlesSignals: bool,
                     main: Function.t,
                     objectTypes: ObjectType.t vector}

            val clear: t -> unit
            val checkHandlers: t -> unit
            (* dfs (p, v) visits the functions in depth-first order, applying v f
             * for function f to yield v', then visiting b's descendents,
             * then applying v' ().
             *)
            val dfs: t * (Function.t -> unit -> unit) -> unit
            val dropProfile: t -> t
            val layouts: t * (Layout.t -> unit) -> unit
            val layoutStats: t -> Layout.t
            val orderFunctions: t -> t
            val shrink: t -> t
            val typeCheck: t -> unit
         end
   end
Commit	Line	Data
7f918cf1 CE	1	(* Copyright (C) 2009,2017 Matthew Fluet.
	2	* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
	3	* Jagannathan, and Stephen Weeks.
	4	* Copyright (C) 1997-2000 NEC Research Institute.
	5	*
	6	* MLton is released under a BSD-style license.
	7	* See the file MLton-LICENSE for details.
	8	*)
	9
	10	signature RSSA_STRUCTS =
	11	sig
	12	include ATOMS
	13
	14	structure Handler: HANDLER
	15	structure ObjectType: OBJECT_TYPE
	16	structure ObjptrTycon: OBJPTR_TYCON
	17	structure Return: RETURN
	18	structure Runtime: RUNTIME
	19	structure Scale: SCALE
	20	structure Type: REP_TYPE
	21
	22	sharing Atoms = Type
	23	sharing Handler = Return.Handler
	24	sharing Label = Handler.Label = Return.Label
	25	sharing ObjectType = Type.ObjectType
	26	sharing ObjptrTycon = ObjectType.ObjptrTycon = Type.ObjptrTycon
	27	sharing Runtime = Type.Runtime
	28	sharing Scale = Type.Scale
	29	end
	30
	31	signature RSSA =
	32	sig
	33	include RSSA_STRUCTS
	34
	35	structure Switch: SWITCH
	36	sharing Atoms = Switch
	37
	38	structure Operand:
	39	sig
	40	datatype t =
	41	ArrayOffset of {base: t,
	42	index: t,
	43	offset: Bytes.t,
	44	scale: Scale.t,
	45	ty: Type.t}
	46	\| Cast of t * Type.t
	47	\| Const of Const.t
	48	(* EnsuresBytesFree is a pseudo-op used by C functions (like
	49	* GC_allocateArray) that take a number of bytes as an argument
	50	* and ensure that that number of bytes is free upon return.
	51	* EnsuresBytesFree is replaced by the limit check pass with
	52	* a real operand.
	53	*)
	54	\| EnsuresBytesFree
	55	\| GCState
	56	\| Offset of {base: t,
	57	offset: Bytes.t,
	58	ty: Type.t}
	59	\| ObjptrTycon of ObjptrTycon.t
	60	\| Runtime of Runtime.GCField.t
	61	\| Var of {ty: Type.t,
	62	var: Var.t}
	63
	64	val bool: bool -> t
65	val cast: t * Type.t -> t
66	val layout: t -> Layout.t
67	val null: t
68	val replaceVar: t * (Var.t -> t) -> t
69	val ty: t -> Type.t
70	val word: WordX.t -> t
71	val zero: WordSize.t -> t
72	end
73	sharing Operand = Switch.Use
74
75	structure Statement:
76	sig
77	datatype t =
78	Bind of {dst: Var.t * Type.t,
79	isMutable: bool,
80	src: Operand.t}
81	\| Move of {dst: Operand.t,
82	src: Operand.t}
83	\| Object of {dst: Var.t * Type.t,
84	header: word,
85	size: Bytes.t (* including header *)}
86	\| PrimApp of {args: Operand.t vector,
87	dst: (Var.t * Type.t) option,
88	prim: Type.t Prim.t}
89	\| Profile of ProfileExp.t
90	\| ProfileLabel of ProfileLabel.t
91	\| SetExnStackLocal
92	\| SetExnStackSlot
93	\| SetHandler of Label.t (* label must be of Handler kind. *)
94	\| SetSlotExnStack
95
96	(* foldDef (s, a, f)
97	* If s defines a variable x, then return f (x, a), else return a.
98	*)
99	val foldDef: t * 'a * (Var.t * Type.t * 'a -> 'a) -> 'a
100	(* foreachDef (s, f) = foldDef (s, (), fn (x, ()) => f x) *)
101	val foreachDef: t * (Var.t * Type.t -> unit) -> unit
102	val foreachDefUse: t * {def: (Var.t * Type.t) -> unit,
103	use: Var.t -> unit} -> unit
104	val foldUse: t * 'a * (Var.t * 'a -> 'a) -> 'a
105	val foreachUse: t * (Var.t -> unit) -> unit
106	val layout: t -> Layout.t
107	val replaceUses: t * (Var.t -> Operand.t) -> t
108	val resize: Operand.t * Type.t -> Operand.t * t list
109	val toString: t -> string
110	end
111
112	structure Transfer:
113	sig
114	datatype t =
115	Arith of {args: Operand.t vector,
116	dst: Var.t,
117	overflow: Label.t, (* Must be nullary. *)
118	prim: Type.t Prim.t,
119	success: Label.t, (* Must be nullary. *)
120	ty: Type.t}
121	\| CCall of {args: Operand.t vector,
122	func: Type.t CFunction.t,
123	(* return is NONE iff the CFunction doesn't return.
124	* Else, return must be SOME l, where l is of kind
125	* CReturn. The return should be nullary if the C
126	* function returns void. Else, it should be unary with
127	* a var of the appropriate type to accept the result.
128	*)
129	return: Label.t option}
130	\| Call of {args: Operand.t vector,
131	func: Func.t,
132	return: Return.t}
133	\| Goto of {args: Operand.t vector,
134	dst: Label.t}
135	(* Raise implicitly raises to the caller.
136	* I.E. the local handler stack must be empty.
137	*)
138	\| Raise of Operand.t vector
139	\| Return of Operand.t vector
140	\| Switch of Switch.t
141
142	val bug: unit -> t
143	(* foldDef (t, a, f)
144	* If t defines a variable x, then return f (x, a), else return a.
145	*)
146	val foldDef: t * 'a * (Var.t * Type.t * 'a -> 'a) -> 'a
147	(* foreachDef (t, f) = foldDef (t, (), fn (x, ()) => f x) *)
148	val foreachDef: t * (Var.t * Type.t -> unit) -> unit
149	val foreachDefLabelUse: t * {def: Var.t * Type.t -> unit,
150	label: Label.t -> unit,
151	use: Var.t -> unit} -> unit
152	val foreachFunc: t * (Func.t -> unit) -> unit
153	val foreachLabel: t * (Label.t -> unit) -> unit
154	val foreachUse: t * (Var.t -> unit) -> unit
155	val ifBool: Operand.t * {falsee: Label.t, truee: Label.t} -> t
156	(* in ifZero, the operand should be of type defaultWord *)
157	val ifZero: Operand.t * {falsee: Label.t, truee: Label.t} -> t
158	val layout: t -> Layout.t
159	val replaceUses: t * (Var.t -> Operand.t) -> t
160	end
161
162	structure Kind:
163	sig
164	datatype t =
165	Cont of {handler: Handler.t}
166	\| CReturn of {func: Type.t CFunction.t}
167	\| Handler
168	\| Jump
169
170	datatype frameStyle = None \| OffsetsAndSize \| SizeOnly
171	val frameStyle: t -> frameStyle
172	end
173
174	structure Block:
175	sig
176	datatype t =
177	T of {args: (Var.t * Type.t) vector,
178	kind: Kind.t,
179	label: Label.t,
180	statements: Statement.t vector,
181	transfer: Transfer.t}
182
183	val clear: t -> unit
184	val kind: t -> Kind.t
185	val label: t -> Label.t
186	val layout: t -> Layout.t
187	end
188
189	structure Function:
190	sig
191	type t
192
193	val blocks: t -> Block.t vector
194	val clear: t -> unit
195	val dest: t -> {args: (Var.t * Type.t) vector,
196	blocks: Block.t vector,
197	name: Func.t,
198	raises: Type.t vector option,
199	returns: Type.t vector option,
200	start: Label.t}
201	(* dfs (f, v) visits the blocks in depth-first order, applying v b
202	* for block b to yield v', then visiting b's descendents,
203	* then applying v' ().
204	*)
205	val dfs: t * (Block.t -> unit -> unit) -> unit
206	val foreachDef: t * (Var.t * Type.t -> unit) -> unit
207	val foreachUse: t * (Var.t -> unit) -> unit
208	val name: t -> Func.t
209	val new: {args: (Var.t * Type.t) vector,
210	blocks: Block.t vector,
211	name: Func.t,
212	raises: Type.t vector option,
213	returns: Type.t vector option,
214	start: Label.t} -> t
215	end
216
217	structure Program:
218	sig
219	datatype t =
220	T of {functions: Function.t list,
221	handlesSignals: bool,
222	main: Function.t,
223	objectTypes: ObjectType.t vector}
224
225	val clear: t -> unit
226	val checkHandlers: t -> unit
227	(* dfs (p, v) visits the functions in depth-first order, applying v f
228	* for function f to yield v', then visiting b's descendents,
229	* then applying v' ().
230	*)
231	val dfs: t * (Function.t -> unit -> unit) -> unit
232	val dropProfile: t -> t
233	val layouts: t * (Layout.t -> unit) -> unit
234	val layoutStats: t -> Layout.t
235	val orderFunctions: t -> t
236	val shrink: t -> t
237	val typeCheck: t -> unit
238	end
239	end