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

SCM Repository

[diderot] View of /trunk/src/compiler/IL/expr-fn.sml
ViewVC logotype

View of /trunk/src/compiler/IL/expr-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 435 - (download) (annotate)
Tue Oct 19 13:14:20 2010 UTC (8 years, 10 months ago) by jhr
File size: 2573 byte(s)
  Upated URL in header to diderot-language.cs.uchicago.edu
(* expr-fn.sml
 *
 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * This functor implements hash-consing for IL expressions.  It can be used to implement
 * optimizations such as CSE and PRE.
 *)

signature EXPR =
  sig

    structure IL : SSA
    structure Op : OPERATORS where type rator = IL.Op.rator

    datatype expr_nd
      = VAR of IL.var
      | LIT of Literal.literal
      | APP of Op.rator * expr list
      | CONS of expr list

    withtype expr = expr_nd HashCons.obj

    val same : expr * expr -> bool

  (* hash-cons construction of expressions *)
    type tbl

    val mkVAR  : tbl -> IL.var -> expr
    val mkLIT  : tbl -> Literal.literal -> expr
    val mkAPP  : tbl -> Op.rator * expr list -> expr
    val mkCONS : tbl -> expr list -> expr

  (* tables, sets, and maps *)
    structure Tbl : MONO_HASH_TABLE where type Key.hash_key = expr
    structure Set : ORD_SET where type Key.ord_key = expr
    structure Map : ORD_MAP where type Key.ord_key = expr

  end

functor ExprFn (IL : SSA) : EXPR =
  struct

    structure IL = IL
    structure Op = IL.Op
    structure HC = HashCons

    datatype expr_nd
      = VAR of IL.var
      | LIT of Literal.literal
      | APP of Op.rator * expr list
      | CONS of expr list

    withtype expr = expr_nd HashCons.obj

    val same : expr * expr -> bool = HC.same
    val same' = ListPair.allEq same

    fun sameNd (VAR x, VAR y) = IL.Var.same(x, y)
      | sameNd (LIT a, LIT b) = Literal.same(a, b)
      | sameNd (APP(op1, args1), APP(op2, args2)) =
	  Op.same(op1, op2) andalso same'(args1, args2)
      | sameNd (CONS args1, CONS args2) = same'(args1, args2)
      | sameNd _ = false

  (* hash-cons construction of expressions *)
    datatype tbl = Tbl of expr_nd HC.tbl

    fun new () = Tbl(HC.new{eq = sameNd})

    fun mkVAR (Tbl tbl) x = HC.cons0 tbl (0w7919 + IL.Var.hash x, VAR x)
    fun mkLIT (Tbl tbl) a = HC.cons0 tbl (0w6997 + Literal.hash a, LIT a)
    fun mkAPP (Tbl tbl) (rator, args) =
	  HC.consList tbl (Op.hash rator, fn args => APP(rator, args)) args
    fun mkCONS (Tbl tbl) args = HC.consList tbl (0w5987, CONS) args

  (* hash tables *)
    structure Tbl = HashTableFn (
      struct
	type hash_key = expr
	fun hashVal (e : expr) = #tag e
	val sameKey = same
      end)

  (* sets and maps *)
    structure Ord =
      struct
	type ord_key = expr
	fun compare (e1 : expr, e2 : expr) = Word.compare(#tag e1, #tag e2)
      end
    structure Set = RedBlackSetFn (Ord)
    structure Map = RedBlackMapFn (Ord)

  end

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