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/nonrec.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4054 - (download) (annotate)
Wed Feb 4 20:42:42 2015 UTC (4 years, 6 months ago) by dbm
File size: 1245 byte(s)
Initial import of archive (of early versions of sml/nj)
structure Nonrec =
struct
local open Access Basics Absyn
in
    exception Isrec

    fun nonrec (VALRECdec[RVB{var=var as VALvar{access=LVAR(lvar),...},
		              exp,resultty,tyvars}]) =
	let val rec findexp =
		fn VARexp(ref(VALvar{access=PATH[v],...})) =>
					if v=lvar then raise Isrec else ()
		 | VARexp(ref(VALvar{access=_,...})) => ()
	         | RECORDexp l => app (fn (lab,e)=>findexp e) l
		 | SEQexp l => app findexp l
		 | APPexp (a,b) => (findexp a; findexp b)
		 | CONSTRAINTexp (e,_) => findexp e
		 | HANDLEexp (e, HANDLER h) => (findexp e; findexp h)
		 | RAISEexp e => findexp e
		 | LETexp (d,e) => (finddec d; findexp e)
		 | CASEexp (e,l) => (findexp e; app (fn RULE (_,e) => findexp e) l)
		 | FNexp l =>  app (fn RULE (_,e) => findexp e) l
		 | _ => ()
	    and finddec =
		fn VALdec vbl => app (fn (VB{exp,...})=>findexp exp) vbl
		 | VALRECdec rvbl => app (fn(RVB{exp,...})=>findexp exp) rvbl
		 | LOCALdec (a,b) => (finddec a; finddec b)
		 | SEQdec l => app finddec l
		 | _ => ()
	 in findexp exp;
	    VALdec[VB{pat=VARpat var, tyvars=tyvars,
		      exp = case resultty of 
				SOME ty => CONSTRAINTexp(exp,ty)
			      | NONE => exp}]
	end

      | nonrec _ = raise Isrec

end (* local *)
end (* struct *)

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