module Atom
    (   Atom()
    ,   mkAtom
    ) where

import IOExts
import FiniteMap

newtype Atom = MkAtom String

instance Eq Atom where
    (==) = unsafePtrEq

instance Ord Atom where
    (MkAtom x) <= (MkAtom x')      = x <= x'
    (MkAtom x) <  (MkAtom x')      = x <  x'
    (MkAtom x) >= (MkAtom x')      = x >= x'
    (MkAtom x) >  (MkAtom x')      = x >  x'
    compare (MkAtom x) (MkAtom x') = compare x x'

instance Show Atom where
    show (MkAtom x) = x


atomTable :: IORef (FiniteMap String Atom)
atomTable = unsafePerformIO (newIORef emptyFM)

mkAtom str
    = do
      fm <- readIORef atomTable
      case lookupFM fm str of
       Just x  -> return x
       Nothing -> let
		    atom = MkAtom str
		   in do
		      writeIORef atomTable (addToFM fm str atom)
		      return atom