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/primop-branch-3/compiler/Elaborator/modules/expandtycon.sml
ViewVC logotype

View of /sml/branches/primop-branch-3/compiler/Elaborator/modules/expandtycon.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2571 - (download) (annotate)
Sun May 20 15:12:54 2007 UTC (12 years, 3 months ago) by dbm
File size: 2565 byte(s)
split of TYCspec in Modules into regular and inferred variants using new tycSpecInfo datatype for an info field of TYPspec. Purpose to support printing of inferred functor sigs
(* expandtycon.sml
 *
 * (C) 2001 Lucent Technologies, Bell Labs
 *)
signature EXPAND_TYCON =
sig
  type sigContext = Modules.elements list
  val expandTycon : Types.tycon * sigContext * EntityEnv.entityEnv -> Types.tycon
  val debugging : bool ref
end

structure ExpandTycon : EXPAND_TYCON =
struct

local (* imported structures *)
  structure T = Types
  structure TU = TypesUtil
  structure EP = EntPath
  structure M = Modules
  structure MU = ModuleUtil
in

(* debugging hooks *)
val say = Control_Print.say
val debugging = ref false
fun debugmsg (msg: string) =
      if !debugging then (say msg; say "\n") else ()
fun bug s = ErrorMsg.impossible ("ExpandTycon: " ^ s)

type sigContext = M.elements list

exception OUTER

(* ignoring FCTspec - won't find any types there *)
fun lookEntVar(ev,(_,s as (M.TYCspec{entVar,...} |
                           M.STRspec{entVar,...}))::rest) =
      if EP.eqEntVar(ev,entVar) then SOME s else lookEntVar(ev,rest)
  | lookEntVar(ev,_::rest) = lookEntVar(ev,rest)
  | lookEntVar(ev,nil) = NONE

fun findContext(ev,context as elements0::outer) =
      (case lookEntVar(ev, elements0)
	 of SOME(M.STRspec{sign as M.SIG {elements,...},...}) =>
	    elements :: context
	  | NONE => findContext(ev,outer)
	  | _ => bug "findContext - bad element")
  | findContext(ev,nil) = raise OUTER

fun expandTycon(tycon,context,entEnv) =
    let fun expandTycVar(ev,context as elements::outer) : T.tycon =
	      (case lookEntVar(ev, elements)
		 of SOME(M.TYCspec{info=M.RegTycSpec{spec,...},...}) =>
		     (case spec
			of T.GENtyc _ => spec
			 | T.DEFtyc{stamp,strict,path,tyfun} =>
			     T.DEFtyc{stamp=stamp,strict=strict,path=path,
				      tyfun=expandTyfun(tyfun,context)}
			 | _ => bug "expandTycon 2")
		  | NONE => (* try outer context *)
		     expandTycVar(ev,outer)
		  | _ => bug "expandTycon 1")
	  | expandTycVar(ev,nil) = raise OUTER

	and expandTyc context = 
	     fn (tyc as T.PATHtyc{entPath,...}) =>
	         (expandPath(entPath,context)
		  handle OUTER => (* path outside current signature context *)
		    MU.transTycon entEnv tyc)
	      | tyc => tyc

	and expandTyfun(T.TYFUN{arity,body},context) = 
	     T.TYFUN{arity=arity,
		     body=TU.mapTypeFull (expandTyc context) body}

	and expandPath(ep, context) =
	    (case ep
	       of nil => bug "expandPath 1"
		| ev :: nil =>  (* tycon! *)
		   expandTycVar(ev,context)
		| ev :: rest => (* substructure! *)
		   expandPath(rest,findContext(ev, context)))

     in expandTyc context tycon
    end

end (* local *)
end (* structure ExpandTycon *)

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