mlton/ast/ast-id.fun

   1 (* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  * Copyright (C) 1997-2000 NEC Research Institute.
   4  *
   5  * MLton is released under a BSD-style license.
   6  * See the file MLton-LICENSE for details.
   7  *)
   8
   9 functor AstId (S: AST_ID_STRUCTS): AST_ID =
  10 struct
  11
  12 open S
  13
  14 datatype t = T of {name: Symbol.t,
  15                    region: Region.t}
  16
  17 type obj = t
  18 type node' = Symbol.t
  19
  20 local
  21    fun make f (T r) = f r
  22 in
  23    val name = make #name
  24    val region = make #region
  25 end
  26
  27 val node = name
  28 (* quell unused warning *)
  29 val _ = node
  30 val toSymbol = name
  31
  32 fun makeRegion (s, r) = T {name = s,
  33                            region = r}
  34
  35 val fromSymbol = makeRegion
  36
  37 fun makeRegion' (s, x, y) =
  38    makeRegion (s, Region.make {left = x, right = y})
  39 (* quell unused warning *)
  40 val _ = makeRegion'
  41
  42 fun dest (T {name, region, ...}) = (name, region)
  43 (* quell unused warning *)
  44 val _ = dest
  45
  46 val bogus = makeRegion (Symbol.bogus, Region.bogus)
  47
  48 fun isAlphaNumeric id =
  49    let
  50       val c = String.sub (Symbol.toString (name id), 0)
  51    in
  52       Char.isAlphaNum c orelse c = #"'"
  53    end
  54
  55 val isSymbolic = not o isAlphaNumeric
  56
  57 val toString = Symbol.toString o name
  58
  59 val layout = String.layout o toString
  60
  61 (* val left = Region.left o region *)
  62 (* val right = Region.left o region *)
  63
  64 local
  65    fun binary (f: string * string -> 'a) (x :t, y: t): 'a =
  66       f (toString x, toString y)
  67 in
  68    val compare = binary String.compare
  69 end
  70
  71 fun equals (x, x') = Symbol.equals (name x, name x')
  72
  73 val equals = Trace.trace2 ("AstId.equals", layout, layout, Bool.layout) equals
  74
  75 end