RSSA

[Stephen Weeks]

I started to work on translating SSA to RSSA and found a few problems
with my last proposal.  Here's the latest.  Hopefully, I'll finish the
SSA -> RSSA translation tomorrow.

--------------------------------------------------------------------------------

type int = Int.t
type word = Word.t
   
signature RSSA_STRUCTS = 
   sig
      include ATOMS
   end

signature RSSA = 
   sig
      include RSSA_STRUCTS

      structure Func: HASH_ID
      structure Label: HASH_ID
      structure Type: MTYPE

      structure Operand:
	 sig
	    datatype t =
	       CastInt of Var.t
	     | Const of Const.t
	     | Var of Var.t
	     | Offset of {base: Var.t,
			  bytes: int}
	     | OffsetScale of {base: Var.t,
			       index: Var.t,
			       scale: int}

	    val int: int -> t
	    val layout: t -> Layout.t
	 end
	       
      structure Statement:
	 sig
	    datatype t =
	       Array of {dst: Var.t,
			 numBytesNonPointers: int,
			 numElts: Var.t,
			 numPointers: int}
	     | Move of {dst: Operand.t,
			src: Operand.t}
	     | Object of {dst: Var.t,
			  numPointers: int,
			  numWordsNonPointers: int,
			  stores: {offset: int, (* bytes *)
				   value: Operand.t} vector}
	     | PrimApp of {dst: (Var.t * Type.t) option,
			   prim: Prim.t,
			   args: Var.t vector}
	     | SetExnStackLocal
	     | SetExnStackSlot
	     | SetHandler of Label.t
	     | SetSlotExnStack
	 end
      
      structure Cases: MACHINE_CASES sharing Label = Cases.Label

      structure Handler:
	 sig
	    datatype t =
	       CallerHandler
	     | None
	     | Handle of Label.t
	 end

      structure Return:
	 sig
	    datatype t =
	       Dead
	     | HandleOnly
	     | NonTail of {cont: Label.t, handler: Handler.t}
	     | Tail
	 end

      structure LimitCheck:
	 sig
	    datatype t =
	       Array of {numElts: Var.t,
			 bytesPerElt: int,
			 extraBytes: int} (* for subsequent allocation *)
	     | Heap of {bytes: int,
			stackToo: bool}
	     | Signal
	     | Stack
	 end
      
      structure Transfer:
	 sig
	    datatype t =
	       Arith of {prim: Prim.t,
			 args: Var.t vector,
			 overflow: Label.t, (* Must be nullary. *)
			 success: Label.t (* Must be unary. *)
			}
	     | Bug  (* MLton thought control couldn't reach here. *)
	     | Call of {func: Func.t,
			args: Var.t vector,
			return: Return.t}
	     | Goto of {dst: Label.t,
			args: Var.t vector
			}
	     | LimitCheck of {kind: LimitCheck.t,
			      return: Label.t}
	     (* Raise implicitly raises to the caller.  
	      * I.E. the local handler stack must be empty.
	      *)
	     | Raise of Var.t vector
	     | Return of Var.t vector
	     | Runtime of {prim: Prim.t,
			   args: Var.t vector,
			   return: Label.t (* Must be nullary. *)
			  }
	     | Switch of {test: Operand.t,
			  cases: Cases.t,
			  default: Label.t option (* Must be nullary. *)
			  }
	     | SwitchIP of {test: Operand.t,
			    int: Label.t,
			    pointer: Label.t}
	 end

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

      structure Function:
	 sig
	    datatype t = T of {args: (Var.t * Type.t) vector,
			       blocks: Block.t vector,
			       name: Func.t,
			       start: Label.t}
	 end
     
      structure Program:
	 sig
	    datatype t =
	       T of {
		     globals: Statement.t vector,
		     functions: Function.t list,
		     main: Func.t (* Must be nullary. *)
		    }
	 end
   end