Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /archive/mlsave.11/translate/unboxed.sml
ViewVC logotype

View of /archive/mlsave.11/translate/unboxed.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4054 - (download) (annotate)
Wed Feb 4 20:42:42 2015 UTC (4 years, 5 months ago) by dbm
File size: 1042 byte(s)
Initial import of archive (of early versions of sml/nj)
structure Unboxed : sig structure Basics : BASICS
			val unboxedAssign : Basics.ty ref -> int
			val unboxedUpdate : Basics.ty ref -> int
		    end
=
struct
  structure Basics = Basics
  open Prim Basics BasicTypes ErrorMsg

  fun alwaysunboxed ty =
    case ty
     of VARty(TYVAR{status=ref(INSTANTIATED t),...}) => alwaysunboxed t
      | VARty _  => false
      | CONty(ref(DATAtyc{dcons=ref l,...}), _) =>
	    not(exists((fn (DATACON{rep=ref(CONSTANT _),...})=>false 
			 | _ => true),
		       l))		    
      | CONty(tr,_) =>
	   (tr = intTycon) orelse (tr = unitTycon)
      | _ => false (* impossible ? *)

  fun unboxedAssign(ref(ty as CONty(_,[CONty(_,[_,VARty(TYVAR{status,...})]),_]))) =
   case !status
	 of INSTANTIATED ty => if alwaysunboxed ty then unboxedAssignSlot
				else assignSlot
	  | _ => assignSlot

  fun unboxedUpdate(ref(CONty(_,[CONty(_,[_,_,VARty(TYVAR{status,...})]),_])))=
       case !status
	 of INSTANTIATED ty => if alwaysunboxed ty then unboxedUpdateSlot
				else updateSlot
	  | _ => updateSlot
  
end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0