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/trunk/src/compiler/FLINT/clos/globalfix.sml
ViewVC logotype

View of /sml/trunk/src/compiler/FLINT/clos/globalfix.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1174 - (download) (annotate)
Sat Mar 23 21:14:40 2002 UTC (17 years, 5 months ago) by leunga
File size: 1473 byte(s)

    Added some new primops for creating/manipulating temporary "C" objects
    allocated on the ml heap.
(* Copyright 1989 by AT&T Bell Laboratories 
 *
 *)
signature GLOBALFIX =
  sig val globalfix : CPS.function -> CPS.function list
  end

structure GlobalFix : GLOBALFIX =
struct
open CPS 
fun globalfix(fk,f,vl,cl,cexp) =
let
fun gfix ce =
case ce 
 of FIX(fl,c) =>
     let val (n,c') = gfix c
	 val l' = foldl
           (fn((k,v,a,t,c),m) => let val (l,d) = gfix c in (k,v,a,t,d)::l@m end)
	     n fl
      in (l',c')
     end
  | APP _ => ([],ce)
  | SWITCH(v,c0,l) =>
     let val (f,l') =
	   foldr (fn(c,(fl,cl)) => let val (f,d) = gfix c in (f@fl,d::cl) end)
	     ([],[]) l
      in (f,SWITCH(v,c0,l'))
     end
  | RECORD(k,l,v,c) => let val (f,c') = gfix c in (f,RECORD(k,l,v,c')) end
  | SELECT(i,v,w,t,c) => let val (f,c') = gfix c in (f,SELECT(i,v,w,t,c')) end
  | OFFSET(i,v,w,c) => let val (f,c') = gfix c in (f,OFFSET(i,v,w,c')) end
  | SETTER(i,vl,c) => let val (f,c') = gfix c in (f,SETTER(i,vl,c')) end
  | LOOKER(i,vl,w,t,c) => let val (f,c') = gfix c in (f,LOOKER(i,vl,w,t,c')) end
  | ARITH(i,vl,w,t,c) => let val (f,c') = gfix c in (f,ARITH(i,vl,w,t,c')) end
  | PURE(i,vl,w,t,c) => let val (f,c') = gfix c in (f,PURE(i,vl,w,t,c')) end
  | RCC(k,l,p,vl,w,t,c) => let val (f,c') = gfix c in (f,RCC(k,l,p,vl,w,t,c')) end
  | BRANCH(i,args,c,e1,e2) =>
	let val (f1,e1') = gfix e1
            val (f2,e2') = gfix e2
         in (f1@f2, BRANCH(i,args,c,e1',e2'))
	end
val (l,body) = gfix cexp
in  (fk,f,vl,cl,body) :: l
end
end (* structure GlobalFix *)


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