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

SCM Repository

[diderot] View of /branches/charisee_dev/src/compiler/high-il/liftSet.sml
ViewVC logotype

View of /branches/charisee_dev/src/compiler/high-il/liftSet.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3415 - (download) (annotate)
Thu Nov 12 20:59:23 2015 UTC (3 years, 10 months ago) by cchiw
File size: 3637 byte(s)
lift in high-il
(* Expands probe ein
 *
 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
 *
 * COPYRIGHT (c) 2015 The University of Chicago
 * All rights reserved.
 *)

structure LiftSet = struct

    local
   
    structure E = Ein
    structure DstIL = HighIL
    structure DstOp = HighOps
    structure P=Printer


    structure DstV  = DstIL.Var
    in

fun hashfn(Ein.EIN{body,...})= let

    fun hash body =let
        fun hashint i = Word.fromInt i
        fun iter[e]=hash e
          | iter(e1::es)=hash e1+iter es
        fun hashMu (E.C c)=hashint c
          | hashMu (E.V v)=hashint v
        fun hashAlpha []=0w3
          | hashAlpha(e1::es)=hashMu(e1)+hashAlpha es
        fun hashDels([])=0w3
          | hashDels((i,j)::es)=hashMu i+hashMu j +hashDels es
        in (case body
            of E.Probe(e1,e2)=> hash e1
             | E.Conv(_,alpha,_ ,dx)=>(case (alpha,dx)
                of([],[])=> 0w5+hashAlpha alpha+hashAlpha dx
(*
                | ([],[_])=> 0w7+hashAlpha alpha+hashAlpha dx
                | ([],[_,_])=>0w11+hashAlpha alpha+hashAlpha dx
                | ([],[_,_,_])=>0w13+hashAlpha alpha+hashAlpha dx
                | ([],[_,_,_,_])=>0w17+hashAlpha alpha+hashAlpha dx
| ([_],[])=> 0w31+hashAlpha alpha+hashAlpha dx
| ([_],[_])=> 0w41+hashAlpha alpha+hashAlpha dx
| ([_],[_,_])=>0w47+hashAlpha alpha+hashAlpha dx
| ([_],[_,_,_])=>0w59+hashAlpha alpha+hashAlpha dx
| ([_],[_,_,_,_])=>0w67+hashAlpha alpha+hashAlpha dx
*)
| ([E.V 0],[])=> 0w5
| ([E.V 0],[_])=> 0w7
| ([E.V 0],[_,_])=>0w11
| ([E.V 0],[_,_,_])=>0w13
| ([E.V 0],[_,_,_,_])=>0w17
| ([E.V _],[])=> 0w61
| ([E.V _],[E.C _])=> 0w67
| ([E.V _],[E.C _,_])=>0w71
| ([E.V _],[E.C _,_,_])=>0w73
| ([E.V _],[E.C _,_,_,_])=>0w79

| ([E.V _],[_])=> 0w43
| ([E.V _],[_,_])=>0w47
| ([E.V _],[_,_,_])=>0w53
| ([E.V _],[_,_,_,_])=>0w59
| ([E.C _],[])=> 0w19
| ([E.C _],[_])=> 0w23
| ([E.C _],[_,_])=>0w29
| ([E.C _],[_,_,_])=>0w31
| ([E.C _],[_,_,_,_])=>0w37


                | _ => 0w109+hashAlpha alpha+hashAlpha dx+hashint(length(dx))
                (*end case*))
            | _ =>0w3
            (*end case*))
        end
    in
        hash body
    end



   fun cmp((_,HighIL.EINAPP(e1,_)),(_,HighIL.EINAPP(e2,_)))=(Word.compare(hashfn e1, hashfn e2))

   structure OprKey =
        struct
        type ord_key =HighIL.var*HighIL.rhs
        val compare = cmp
    end;
    structure  LiftSet= RedBlackSetFn(OprKey);


    fun LiftSetToString(str,v,HighIL.EINAPP(e,args))=(String.concat["\n",str,DstV.toString v,"=",
                P.printerE e,"(",String.concatWith","(List.map DstV.toString args),")\n"])

    fun allEq([], []) = true
      | allEq(x::xs, y::ys) = DstIL.Var.same(x,y) andalso allEq (xs,ys)
      | allEq _ = false

    fun setFind (tbl,_,HighIL.EINAPP(ein0,arg0))= (
        LiftSet.find(
            (fn (_,HighIL.EINAPP(ein1,arg1))=>(EqualEin.isEinEqual(ein0,ein1) andalso allEq(arg0,arg1)))
        )) tbl

    fun rtnVar (tbl,v,e)=(case setFind(tbl,v,e)
        of NONE     => ((LiftSetToString("\n\t inserting: ",v,e));(LiftSet.add(tbl,(v,e)), NONE))
        | SOME(v1,e1) => ( (LiftSetToString("\n\nfound: ",v,e));(LiftSetToString("\n with: ",v1,e1));(tbl,SOME v1))
        (*end case*))

fun rtnVarN (tbl,(v,e))=(case setFind(tbl,v,e)
of NONE     => ((LiftSetToString("\n\t inserting: ",v,e));(LiftSet.add(tbl,(v,e)), NONE))
| SOME(v1,e1) => ( (LiftSetToString("\n\nfound: ",v,e));(LiftSetToString("\n with: ",v1,e1));(tbl,SOME v1))
(*end case*))

    fun setToString tbl=List.map (fn (e1,e2)=> LiftSetToString("\n",e1,e2)) (LiftSet.listItems (tbl))



  end; (* local *)

end (* local *)

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