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

SCM Repository

[diderot] View of /branches/charisee/src/compiler/mid-to-low/lowSet.sml
ViewVC logotype

View of /branches/charisee/src/compiler/mid-to-low/lowSet.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3624 - (download) (annotate)
Fri Jan 29 17:49:01 2016 UTC (4 years, 4 months ago) by jhr
File size: 1561 byte(s)
adding header comments in prep for merge
(* lowSet.sml
 *
 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
 *
 * COPYRIGHT (c) 2016 The University of Chicago
 * All rights reserved.
 *
 * Expands probe ein
 *)

structure lowSet = struct

    local

    structure DstIL =LowIL
    structure DstOp = LowOps
    structure DstV  = DstIL.Var

    in

    fun hash (_,DstIL.OP(op1,_))=DstOp.hash op1
      | hash(_,DstIL.LIT m)=Literal.hash m
      | hash (_,DstIL.CONS _ )=0w17
   fun cmp(e1,e2)=Word.compare(hash e1, hash e2)

   structure OprKey =
        struct
        type ord_key =DstIL.var*LowIL.rhs
        val compare = cmp
    end;
    structure  LowSet= RedBlackSetFn(OprKey);

    fun allEq([], []) = true
      | allEq(x::xs, y::ys) = DstIL.Var.same(x,y) andalso allEq (xs,ys)
      | allEq _ = false
    fun setFind (tbl,DstIL.OP(op0,arg0))= (
        LowSet.find(
            (fn (_,DstIL.OP(op1,arg1))=>(DstOp.same(op0,op1) andalso allEq(arg0,arg1)) | _ => false)
        )) tbl
      |  setFind (tbl,DstIL.LIT n)= (
        LowSet.find(
            (fn (_,DstIL.LIT m)=> Literal.same(n,m)
            | _ => false))) tbl
      | setFind (tbl, e)= NONE
    fun rtnVar (tbl,(lhs,rhs))=(case setFind(tbl,rhs)
        of NONE     => (LowSet.add(tbl,(lhs,rhs)), NONE)
        | SOME(v1,e1) =>(tbl,SOME v1)
        (*end case*))
    fun filter(tbl,(lhs,rhs))=(case rhs
        of DstIL.OP _ => rtnVar(tbl,(lhs,rhs))
        | DstIL.LIT _ => rtnVar(tbl,(lhs,rhs))
        | _ =>          (tbl, NONE)
        (*end case*))


  end; (* local *)

end (* local *)

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