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 /sml/branches/temi-branch/compiler/Elaborator/types/overloadlit.sml
ViewVC logotype

View of /sml/branches/temi-branch/compiler/Elaborator/types/overloadlit.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3020 - (download) (annotate)
Wed May 7 02:59:25 2008 UTC (11 years, 3 months ago) by aleffert
File size: 1929 byte(s)
rolled in markty stuff
(* COPYRIGHT 1997 Bell Laboratories *)
(* overloadlit.sml *)

(* overloaded literals *)
signature OVERLOADLIT =
sig

  (* functions for setting up, recording, and resolving literal overloadings *)
  val new : unit -> { push : Types.ty -> unit, resolve : unit -> unit }

  (* isLiteralTy is for checking compatability when instantiating 
     overloaded literal type variables *)
  val isLiteralTy : Types.litKind * Types.ty -> bool
end  (* signature OVERLOADLIT *)

structure OverloadLit : OVERLOADLIT = 
struct

  structure T = Types
  structure BT = BasicTypes
  structure TU = TypesUtil

  (* eventually, these may be defined elsewhere, perhaps via some
     compiler configuration mechanism *)
  val intTypes = [BT.intTy, BT.int32Ty, BT.int64Ty, BT.intinfTy]
  val wordTypes = [BT.wordTy, BT.word8Ty, BT.word32Ty, BT.word64Ty]
  val realTypes = [BT.realTy]
  val charTypes = [BT.charTy]
  val stringTypes = [BT.stringTy]

  fun inClass(ty, tys) = List.exists (fn ty' => TU.equalType(ty,ty')) tys

  fun isLiteralTy(T.INT,ty) = inClass(ty,intTypes)
    | isLiteralTy(T.WORD,ty) = inClass(ty,wordTypes)
    | isLiteralTy(T.REAL,ty) = inClass(ty,realTypes)
    | isLiteralTy(T.CHAR,ty) = inClass(ty,charTypes)
    | isLiteralTy(T.STRING,ty) = inClass(ty,stringTypes)

  fun default T.INT = BT.intTy
    | default T.WORD = BT.wordTy
    | default T.REAL = BT.realTy
    | default T.CHAR = BT.charTy
    | default T.STRING = BT.stringTy

  fun new () = let
      val lits = ref []
      fun push x = lits := x :: !lits
      fun resolve () =
	  let fun resolveLit ty =
		  case TU.prune ty
		  of (T.VARty(tv as ref(T.LITERAL{kind,...})) | 
		      T.MARKty(T.VARty(tv as ref(T.LITERAL{kind,...})),_)) =>
		      tv := T.INSTANTIATED(default kind)
		    | _ => () (* ok, must have been successfully instantiated *)
	  in app resolveLit (!lits)
	  end
  in { push = push, resolve = resolve }
  end

end (* structure OverloadLit *)

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