Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /branches/charisee_dev/src/compiler/high-to-mid/einVarSet.sml
ViewVC logotype

Annotation of /branches/charisee_dev/src/compiler/high-to-mid/einVarSet.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3540 - (view) (download)

1 : cchiw 3540 (* Expands probe ein
2 :     *
3 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2015 The University of Chicago
6 :     * All rights reserved.
7 :     *)
8 :    
9 :     structure einVarSet = struct
10 :    
11 :     local
12 :    
13 :     structure E = Ein
14 :     structure DstIL = MidIL
15 :     structure DstOp = MidOps
16 :     structure P=Printer
17 :     structure MidToS=MidToString
18 :     structure DstV = DstIL.Var
19 :     in
20 :    
21 :    
22 :     fun decUse(DstIL.V{useCnt, ...}) = (useCnt := !useCnt - 1)
23 :     fun getUse(DstIL.V{useCnt, ...})= Int.toString(!useCnt)
24 :     datatype keyset
25 :     = RHS of MidIL.var*MidIL.rhs
26 :     | VAR of MidIL.var*MidIL.var
27 :    
28 :    
29 :     fun cmp0(RHS(_,MidIL.EINAPP(e1,_)))= HashEin.hashfn e1
30 :     | cmp0(VAR(v0,v1))= (DstIL.Var.hash v0)+(DstIL.Var.hash v1)
31 :     | cmp0 (RHS(_,DstIL.OP(op1,_)))=DstOp.hash op1
32 :     | cmp0(RHS(_,DstIL.LIT m))=Literal.hash m
33 :     | cmp0(RHS(_,DstIL.CONS _ ))=0w17
34 :     | cmp0(RHS(_,DstIL.VAR v ))=DstIL.Var.hash v
35 :    
36 :     fun cmp(e1,e2)=Word.compare(cmp0 e1,cmp0 e2)
37 :    
38 :    
39 :     structure OprKey =
40 :     struct
41 :     type ord_key = keyset
42 :     val compare = cmp
43 :     end;
44 :     structure EinVarSet= RedBlackSetFn(OprKey);
45 :     structure VarSet= RedBlackSetFn(OprKey);
46 :    
47 :    
48 :     fun allEq([], []) = true
49 :     | allEq(x::xs, y::ys) = DstIL.Var.same(x,y) andalso allEq (xs,ys)
50 :     | allEq _ = false
51 :    
52 :     fun setFindE (tbl,_,MidIL.EINAPP(ein0,arg0))= (
53 :     EinVarSet.find(
54 :     (fn (RHS(_,MidIL.EINAPP(ein1,arg1)))=>let
55 :     val t=EqualEin.isEinEqual(ein0,ein1)
56 :     val k= allEq(arg0,arg1)
57 :     val _= if t then
58 :     if k then ""
59 :     else (String.concat["*** \n\n ein1: ",P.printerE(ein0),"\n=\n ein2:",P.printerE(ein1)])
60 :     else ""
61 :    
62 :     in t andalso k end | _ =>false
63 :     ))) tbl
64 :     | setFindE (tbl,_,MidIL.OP(ein0,arg0))= (
65 :     EinVarSet.find(
66 :     (fn (RHS(_,MidIL.OP(ein1,arg1)))=>( MidOps.same(ein0,ein1) andalso allEq(arg0,arg1)) | _ =>false
67 :     ))) tbl
68 :     | setFindE (tbl,_,MidIL.VAR ein0)= (
69 :     EinVarSet.find(
70 :     (fn (RHS(_,MidIL.VAR ein1))=> DstIL.Var.same(ein0,ein1) | _ =>false
71 :     ))) tbl
72 :     | setFindE _ = NONE
73 :    
74 :     fun varToStr v=String.concat[DstV.toString v, "(",getUse v,")"]
75 :     fun pst(x,v)= (String.concat["\ncompare:",varToStr x ,"--tmp",varToStr v])
76 :     fun setFindV (tbl,v)= (VarSet.find((fn (VAR(_,x))=> (pst(x,v);DstIL.Var.same(x,v)) | _ =>false))) tbl
77 :    
78 :     fun replaceArg(tbl,arg)= (case setFindV(tbl,arg)
79 :     of NONE => ((String.concat["\n NONE ARG ", varToStr arg]);arg)
80 :     | SOME(VAR(x0,x1)) => (decUse(x1);(String.concat["\n found ARG ",varToStr x0,"=",varToStr x1]); x0)
81 :     (*end case*))
82 :    
83 :     fun rtnVarN (tbl,(v,e))=(case setFindE(tbl,v,e)
84 :     of NONE => ((String.concat["\n RtnVar NONE ",varToStr v]);(EinVarSet.add(tbl,RHS(v,e)), NONE))
85 :     | SOME(RHS(v1,_)) => ((String.concat["\n RtnVar SOME orig- ",varToStr v1," tmp-",varToStr v]);(EinVarSet.add(tbl,VAR(v1,v)),SOME v1))
86 :     (*end case*))
87 :    
88 :    
89 :    
90 :     fun EinVarSetToString(str,RHS(v,MidIL.EINAPP(e,args)))=(String.concat["\n",str,DstV.toString v,"=",
91 :     P.printerE e,"(",String.concatWith","(List.map DstV.toString args),")\n"])
92 :     |EinVarSetToString _ =""
93 :    
94 :    
95 :     end; (* local *)
96 :    
97 :     end (* local *)

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