shithub: MicroHs

Download patch

ref: 91863720982eeb271cb46aa61928848b15d71357
parent: 0e13031ea697df5cf439946484da24f991f75e41
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Thu Sep 21 20:08:23 EDT 2023

Switch to Adams trees for the IdentMap

--- a/Makefile
+++ b/Makefile
@@ -54,6 +54,7 @@
 	$(GHCC) -c lib/Data/Tuple.hs
 	$(GHCC) -c lib/Data/Function.hs
 	$(GHCC) -c lib/Data/Maybe.hs
+	$(GHCC) -c lib/Data/Ord.hs
 	$(GHCC) -c lib/Data/List.hs
 	$(GHCC) -c lib/Text/String.hs
 	$(GHCC) -c lib/Data/Word.hs
@@ -77,6 +78,7 @@
 	$(GHCC) -c src/MicroHs/Lex.hs
 	$(GHCC) -c src/MicroHs/Parse.hs
 	$(GHCC) -c src/MicroHs/IdentMap.hs
+#	$(GHCC) -c src/MicroHs/BBMap.hs
 	$(GHCC) -c src/MicroHs/StringMapFast.hs
 #	$(GHCC) -c -package containers -package base src/MicroHs/StringMap.hs
 	$(GHCC) -c src/MicroHs/Exp.hs
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v3.5
-886
-(($A :0 ((_674 _623) (($B ((($S' ($C (($C (($C $S') _3)) ((($C' ($C' $P)) ((($C' $B) _1) _606)) ($K ($K (_820 "Usage: mhs [-v] [-r] [-iPATH] [-oFILE] [ModuleName]"))))))) (($S (($S ((($S' _27) (($B _728) (_715 (_666 "-v")))) ((_745 _666) "-r"))) (($B (_709 (($O 46) $K))) (($B _774) (_714 ((_733 _796) "-i")))))) (($B (_775 _741)) ((($C' _711) (($B _774) (_714 ((_733 _796) "-o")))) (($O "out.comb") $K))))) (_715 ((_776 _816) ((_776 (_666 (($O 45) $K))) (_726 1)))))) (_737 ((_776 _816) (_666 "--")))))) (($A :1 ((($S' ($S' _674)) _39) (($B ($B ($B (_674 _705)))) ((($C' ($C' ($C' $C))) ((($C' $B) (($B ($C' $C)) ((($C' ($S' ($C' $C'))) (($B ($B ($B $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($S' ($C' $S'))))) ((($C' ($C' ($C' ($C' ($C' $C'))))) ((($C' ($S' ($C' ($C' ($C' $C'))))) (($B ($B ($B ($B $B')))) ((($C' ($S' ($C' $B))) (($B ($B ($B $C))) ((($S' $B) ($B' (($B ($S' $C')) (($B $B') (($B ($B _675)) ((($C' $B) (($B _775) (($B _695) ((($C' _811) _28) 0)))) (($B (_775 _698)) (($B (_711 "top level defns: ")) _654)))))))) ((($S' ($C' $B)) (($B $B') (($B $B') (($B $B') (($B ($B _675)) ((($C' $B) (($B _775) (($B _695) ((($C' _811) _28) 1)))) (_694 ($T (($B ($B (_775 _698))) ((($C' $B) (($B _711) ((($C' _711) _612) " = "))) (($C _431) $K))))))))))) ((($C' ($C' ($C' ($C' $B)))) ((($S' $B) ($B' ($B' _29))) ((($S' $B) (($B ($C' ($C' _675))) ((($C' $B) ($B' (($B _775) (($B _700) _31)))) (($B _711) ((($C' _711) (($B (_711 _2)) _654)) (($O 10) $K)))))) (($B ($B (_674 _705))) ((($C' $B) ($B' (($B _775) (($B _695) ((($C' _811) _28) 0))))) (($B ($B (_775 _698))) ((($C' ($C' _711)) (($B ($B (_711 "final pass            "))) (($B ($B (_668 6))) (($B ($B _654)) _805)))) "ms"))))))) _22))))) ($C $P)))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($C _716)) _431))) (($C _729) (_746 0)))) $K))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B (($C' $B) (($B _776) (($B _711) ((($C' _711) (($B (_711 "(($A :")) _654)) (($O 32) $K))))))) ((($C' $B) (($B ($C' _776)) ($B _431))) (($B (_776 (_711 ") "))) (($C _776) (_711 (($O 41) $K))))))))))) $T)) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _406)) $I))) ($BK $K))) $K))))) (($B (($S' _775) (($B _772) (($B (_775 _820)) (($B (_711 "main: findIdent: ")) _612))))) (($C' _642) _609)))) _649))) (($B ($B _646)) (($B (($C' _713) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B (($C' $P) _609))) $K)))))) (($C _729) (_746 0))))))) (($C _615) (_606 "main")))) (($B (_775 _405)) (($B (_775 _606)) (($B (_711 (($O 95) $K))) _654))))))) (($A :2 "v3.5\10&") (($A :3 (($B (_675 (_698 "Welcome to interactive MicroHs!"))) (($B (_675 (_698 "Type ':quit' to quit"))) ((($C' _674) (($B (_579 _5)) ((($C' $C) ($P _4)) _36))) ($K (_676 _822)))))) (($A :4 ((_711 ((_711 ((_711 ((_711 "module ") _7)) "(module ")) _7)) ") where\10&import Prelude\10&import Unsafe.Coerce\10&")) (($A :5 ((_580 ((_775 _589) ((_15 ".mhsi") "> "))) (($P _5) (($C (($S (($C $equal) ":quit")) (($C (($S (($C $equal) ":clear")) (($C (($S ((_733 _796) ":del ")) ((($C' _581) _11) _5))) ((($C' _581) (($B _6) (($B (_776 _664)) ((($C' _776) (($B _715) (($B (_776 _816)) (_734 _796)))) _663)))) _5)))) ((_581 (_6 (_778 _4))) _5)))) ((_775 _589) (_698 "Bye")))))) (($A :6 (($B (_775 _586)) (($B $T) (($B ($B ($B $C))) ($B $P))))) (($A :7 "Interactive") (($A :8 "_it") (($A :9 ((($C' _711) (_711 ((_711 ((_711 ((_711 _8) " :: Any\10&")) _8)) " = unsafeCoerce ("))) ")\10&")) (($A :10 (($B (_775 _698)) (_711 "Error: "))) (($A :11 (($B (_580 _588)) (($B $T) (($B $BK) (($B $BK) (($S ((($S' $S') ((_47 _50) $K)) (($B $BK) (($B ($B ((($S' _580) _12) (($B ($P (($B (_775 _589)) _10))) ($BK (($B _6) _778)))))) ((($C' ($C' _711)) ($C _711)) (($O 10) $K)))))) (($B $BK) ((($C' ($C' _580)) (($B ($B _12)) (($B (($C' _711) (($C _711) (($O 10) $K)))) _9))) (($P (($B (_775 _589)) _10)) _13))))))))) (($A :12 (($B (_580 _588)) (($B $T) (($C ((($C' $C') (($B $C') (($B $C') ($B' (($B _581) (($B (_775 _589)) (_700 ((_711 _7) ".hs")))))))) (($B (($S' ($C' ($S' _
\ No newline at end of file
+883
+(($A :0 _741) (($A :1 (_0 "undefined")) (($A :2 $I) (($A :3 ((($C' $B) _770) (($C _45) _2))) (($A :4 ((($C' _3) (_787 _42)) ((_45 _785) _41))) (($A :5 (($B (($S _816) _785)) _0)) (($A :6 $T) (($A :7 ($T $I)) (($A :8 (($B (_45 _157)) _7)) (($A :9 (($B ($B (_44 _6))) ((($C' $B) (($B $C) _7)) ($B _7)))) (($A :10 (($B ($B (_44 _6))) ((($C' $B) (($B $C) _7)) ($BK _7)))) (($A :11 (($B (_44 _6)) $P)) (($A :12 (($B ($B (_44 _6))) (($B (($C' $C) _7)) ($B $P)))) (($A :13 _12) (($A :14 (($B (_44 _6)) ($B ($P _711)))) (($A :15 (($B (_44 _6)) ($BK ($P _711)))) (($A :16 ((_44 _6) (($S $P) $I))) (($A :17 (($B (_44 _6)) (($C ($S' $P)) $I))) (($A :18 (($B $Y) (($B ($B ($P (_11 _85)))) ((($C' $B) (($B ($C' $B)) ($B _9))) ((($C' ($C' $B)) ($B _9)) (($B ($B _11)) _86)))))) (($A :19 (($B $Y) (($B ($B ($P (_11 _711)))) (($B ($C' $B)) ($B _10))))) (($A :20 _0) (($A :21 ($T (_11 _711))) (($A :22 (($C $C) _29)) (($A :23 ($T _28)) (($A :24 (($P _29) _28)) (($A :25 _29) (($A :26 (($C (($C $S') _24)) $I)) (($A :27 (($C $S) _24)) (($A :28 $K) (($A :29 $A) (($A :30 _746) (($A :31 _747) (($A :32 ((($S' _23) (_738 97)) (($C _738) 122))) (($A :33 ((($S' _23) (_738 65)) (($C _738) 90))) (($A :34 ((($S' _22) _32) _33)) (($A :35 ((($S' _23) (_738 48)) (($C _738) 57))) (($A :36 ((($S' _23) (_738 32)) (($C _738) 126))) (($A :37 _735) (($A :38 _736) (($A :39 _738) (($A :40 _737) (($A :41 (($B $BK) $T)) (($A :42 ($BK $T)) (($A :43 $P) (($A :44 $I) (($A :45 $B) (($A :46 $I) (($A :47 $K) (($A :48 $C) (($A :49 _742) (($A :50 (($C (($C $S') _157)) _158)) (($A :51 ((($C' ($S' ($C' $B))) $B) $I)) (($A :52 _712) (($A :53 _713) (($A :54 _714) (($A :55 _715) (($A :56 _716) (($A :57 _717) (($A :58 (_53 0)) (($A :59 _723) (($A :60 _724) (($A :61 _725) (($A :62 _726) (($A :63 _727) (($A :64 _728) (($A :65 _59) (($A :66 ($BK $K)) (($A :67 (($B $BK) (($B ($B $BK)) $P))) (($A :68 (($B ($B ($B $BK))) (($B ($B ($B $BK))) (($B ($B ($B $C))) (($B ($B $C)) $P))))) (($A :69 ((($S' $S) ((($S' ($S' $C)) ((($C' ($C' $S)) ((($C' $B) (($B ($S' $S')) ((($C' $B) (($B _22) (_62 0))) (_59 0)))) (($B ($B (($C' $P) (_57 1)))) _52))) ($C $P))) _55)) _56)) (($A :70 _66) (($A :71 ((($S' $C) (($B ($P _146)) ((($C' ($C' $B)) ((($C' $C) _59) _146)) _147))) (($B (($C' ($C' ($C' $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) (($B (($C' ($C' ($C' $C))) (($B ($B ($B (($S' $S') (_59 0))))) (($B (($C' ($C' $C)) (($B ($B (($S' $S') (_59 1)))) (($B (($C' $C) (($B (($C' $S') (_59 2))) ($C _71)))) ($C _71))))) ($C _71))))) ($C _71)))) ($T $K))) ($T $A)))) (($C _69) 4)))) (($A :72 (_78 _47)) (($A :73 ((_93 (_50 _72)) _70)) (($A :74 (($C ((($C' $B) (($P _85) ((($C' ($C' $O)) $P) $K))) ((($S' ($C' ($C' ($C' $B)))) (($B ($B ($B ($B _75)))) ((($S' ($C' ($C' $B))) (($B ($B ($B _75))) ((($S' ($C' $B)) (($B ($B _75)) ((($C' $B) (($B _91) ($T 0))) _74))) ((($C' $B) (($B _91) ($T 1))) _74)))) ((($C' $B) (($B _91) ($T 2))) _74)))) ((($C' $B) (($B _91) ($T 3))) _74)))) (($B $T) (($B ($B $P)) (($C' _52) (_54 4)))))) (($A :75 (($S $S) (($B $BK) (($B $BK) ((($S' $S) $T) (($B $BK) (($B $BK) (($C ((($S' $C') $S) (($B ($B ($B ($S $B)))) (($B ($B ($B ($B ($B $BK))))) (($B (($S' ($C' $B)) (($B $B') $B'))) (($B ($B ($B ($B ($B ($S $B)))))) (($B ($B ($B ($B ($B ($B ($B $BK))))))) ((($C' $B) ($B' ($B' (($B ($C' ($C' ($C' $C)))) (($B (($C' $B) ($B' (($B $C) _61)))) (($B (($C' $B) _86)) _75)))))) (($B (($C' $B) _86)) ($C _75)))))))))) (((_710 "lib/Data/IntMap.hs") 3) 8))))))))) (($A :76 ((_45 (_91 _157)) _74)) (($A :77 ((($C' $C) ((($C' $C) ($C _71)) (_0 "Data.IntMap.!"))) $I)) (($A :78 (($B (($C' $B) $T)) (($B ($B $Y)) ((($C' ($C' ($S' ($S' $C)))) (($B (($S' $B) (($B ($S' $P)) ($C _67)))) (($B ($B (($C' ($S' $C)) (($B (($S' ($S' $S')) _59)) ((($C' ($C' $B)) (($B $B') ($B _44))) ((($C' ($C' _44)) _72) ((((_68 _66) _66) _66) _66))))))) ($B (($C' $B) _67))))) ((($C' $B) (($B ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($S' ($S' ($S' ($S' ($S' $C))))) (($B ($B ($B ($B ($B (($S' $S') (_59 0))))))) ((($S' ($S' ($S' ($S' ($S' $C
\ No newline at end of file
--- a/src/MicroHs/Ident.hs
+++ b/src/MicroHs/Ident.hs
@@ -9,7 +9,8 @@
   isLower_, isIdentChar, isOperChar, isConIdent,
   unQualString,
   SLoc(..), noSLoc, isNoSLoc,
-  showSLoc
+  showSLoc,
+  compareIdent,
   ) where
 import Prelude --Xhiding(showString)
 import Data.Char
@@ -93,3 +94,8 @@
 -- Does not force location
 forceIdent :: Ident -> ()
 forceIdent (Ident _ s) = forceString s
+
+compareIdent :: Ident -> Ident -> Ordering
+compareIdent (Ident _ s) (Ident _ t) = compareString s t
+
+
--- a/src/MicroHs/IdentMap.hs
+++ b/src/MicroHs/IdentMap.hs
@@ -1,120 +1,159 @@
--- Copyright 2023 Lennart Augustsson
--- See LICENSE file for full license.
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+--
+-- Balanced binary trees
+-- Similar to Data.Map
+-- Based on https://ufal.mff.cuni.cz/~straka/papers/2011-bbtree.pdf
+--
 module MicroHs.IdentMap(
   Map,
-  size,
-  empty, insert, lookup,
-  delete,
-  fromList, fromListWith,
-  toList, elems
+  insert, fromListWith, fromList, lookup, empty, elems, size, toList, delete,
   ) where
 import Prelude --Xhiding(lookup)
 import MicroHs.Ident
+--Ximport Compat
 
-{-
-import qualified Data.Map as M
-import qualified GHC.Maybe
+data Map a
+  = Nil        -- empty tree
+  | One Ident a      -- singleton
+  | Node       -- tree node
+    (Map a)   -- left subtree
+    Int          -- size of this tree
+    Ident
+    a            -- element stored in the node
+    (Map a)   -- right subtree
+  --Xderiving(Show)
 
-type Map v = M.Map Ident v
+empty :: forall a . Map a
+empty = Nil
 
-insert = M.insert
+elems :: forall v . Map v -> [v]
+elems = map snd . toList
 
-fromListWith = M.fromListWith
+toList :: forall v . Map v -> [(Ident, v)]
+toList t = to t []
+  where
+    to Nil q = q
+    to (One k v) q = (k, v):q
+    to (Node l _ k v r) q = to l ((k, v) : to r q)
 
-fromList = M.fromList
+fromList :: forall v . [(Ident, v)] -> Map v
+fromList = fromListWith const
 
---union = M.union
+fromListWith :: forall v . (v -> v -> v) -> [(Ident, v)] -> Map v
+fromListWith comb = foldr (uncurry (insertWith comb)) empty
 
-lookup k m =
-  case M.lookup k m of
-    GHC.Maybe.Nothing -> Nothing
-    GHC.Maybe.Just v -> Just v
+size :: forall a . Map a -> Int
+size Nil = 0
+size (One _ _) = 1
+size (Node _ s _ _ _) = s
 
-empty = M.empty
+node :: forall a . Map a -> Ident -> a -> Map a -> Map a
+node Nil  key val Nil   = One key val
+node left key val right = Node left (size left + 1 + size right) key val right
 
-elems = M.elems
--}
+lookup :: forall a . Ident -> Map a -> Maybe a
+lookup k = look
+  where
+    look Nil = Nothing
+    look (One key val) | isEQ (compareIdent k key) = Just val
+                       | otherwise = Nothing
+    look (Node left _ key val right) =
+      case k `compareIdent` key of
+        LT -> look left
+        EQ -> Just val
+        GT -> look right
 
--- This is a pretty bad implementation,
--- but linear search is great for small maps.
-newtype Map v = Map [(Ident, v)]
-  --Xderiving(Show)
+insert :: forall a . Ident -> a -> Map a -> Map a
+insert = insertWith const
 
-insert k v (Map kvs) =
-  Map ((k, v):kvs)
-  -- This is much slower
-  --Map ((k, v) : filter (not . eqIdent k . fst) kvs)
+insertWith :: forall a . (a -> a -> a) -> Ident -> a -> Map a -> Map a
+insertWith comb k v = ins
+  where
+    ins Nil = One k v
+    ins (One a v) = ins (Node Nil 1 a v Nil)
+    ins (Node left _ key val right) =
+      case k `compareIdent` key of
+        LT -> balance (ins left) key val right
+        EQ -> node left k (comb v val) right
+        GT -> balance left key val (ins right)
 
-fromListWith un xs =
-  let
-    ins ikv@(ik, iv) =
-      let eq = eqIdent ik
-          loop [] = [ikv]
-          loop (kv@(k, v):kvs) =
-                  if eq k then
-                    (k, un iv v) : kvs
-                  else
-                    kv : loop kvs
-      in  loop
-  in
-     Map (foldr ins [] xs)
+delete :: forall a . Ident -> Map a -> Map a
+delete k = del
+  where
+    del Nil = Nil
+    del t@(One a _) | isEQ (k `compareIdent` a) = Nil
+                    | otherwise        = t
+    del (Node left _ key val right) =
+      case k `compareIdent` key of
+        LT -> balance (del left) key val right
+        EQ -> glue left right
+        GT -> balance left key val (del right)
+      where
+        glue Nil right = right
+        glue left Nil = left
+        glue left right
+          | size left > size right =
+            let (key', val', left') = extractMax left
+            in node left' key' val' right
+          | otherwise =
+            let (key', val', right') = extractMin right
+            in node left key' val' right'
 
-fromList = Map
-  --fromListWith const
+extractMin :: forall a . Map a -> (Ident, a, Map a)
+extractMin Nil = undefined
+extractMin (One key val) = (key, val, Nil)
+extractMin (Node Nil _ key val right) = (key, val, right)
+extractMin (Node left _ key val right) =
+  case extractMin left of
+    (min, vmin, left') -> (min, vmin, balance left' key val right)
 
-{-
-union akvs1 akvs2 =
-  case akvs1 of
-    Map kvs1 ->
-      case akvs2 of
-        Map kvs2 -> Map (kvs1 ++ kvs2)
--}
+extractMax :: forall a . Map a -> (Ident, a, Map a)
+extractMax Nil = undefined
+extractMax (One key val) = (key, val, Nil)
+extractMax (Node left _ key val Nil) = (key, val, left)
+extractMax (Node left _ key val right) =
+  case extractMax right of
+    (max, vmax, right') -> (max, vmax, balance left key val right')
 
-lookup ak (Map m) =
-      let
-        eq = eqIdent ak
-        look akvs =
-          case akvs of
-            [] -> Nothing
-            (k, v) : kvs ->
-              if eq k then Just v else look kvs
-      in look m
+omega :: Int
+omega = 3
+alpha :: Int
+alpha = 2
+delta :: Int
+delta = 0
 
-empty = Map []
+balance :: forall a . Map a -> Ident -> a -> Map a -> Map a
+balance left key val right
+  | size left + size right <= 1 = node left key val right
+balance (One k v) key val right = balance (Node Nil 1 k v Nil) key val right
+balance left key val (One k v)  = balance left key val (Node Nil 1 k v Nil)
+balance left key val right
+  | size right > omega * size left + delta =
+      case right of
+        (Node rl _ _ _ rr) | size rl < alpha*size rr -> singleL left key val right
+                           | otherwise -> doubleL left key val right
+        _ -> undefined
+  | size left > omega * size right + delta =
+      case left of
+        (Node ll _ _ _ lr) | size lr < alpha*size ll -> singleR left key val right
+                           | otherwise -> doubleR left key val right
+        _ -> undefined
+  | otherwise = node left key val right
 
-elems (Map kvs) = map snd kvs
+singleL :: forall a . Map a -> Ident -> a -> Map a -> Map a
+singleL l k v (Node rl _ rk rv rr) = node (node l k v rl) rk rv rr
+singleL _ _ _ _ = undefined
 
-size (Map kvs) = length kvs
+singleR :: forall a . Map a -> Ident -> a -> Map a -> Map a
+singleR (Node ll _ lk lv lr) k v r = node ll lk lv (node lr k v r)
+singleR _ _ _ _ = undefined
 
-toList (Map kvs) = kvs
+doubleL :: forall a . Map a -> Ident -> a -> Map a -> Map a
+doubleL l k v (Node (Node rll _ rlk rlv rlr) _ rk rv rr) = node (node l k v rll) rlk rlv (node rlr rk rv rr)
+doubleL l k v (Node (One        rlk rlv    ) _ rk rv rr) = node (node l k v Nil) rlk rlv (node Nil rk rv rr)
+doubleL _ _ _ _ = undefined
 
-delete i (Map kvs) = Map (filter (\ (k, _) -> not (eqIdent i k)) kvs)
-
-{-
-
-import qualified Data.Map as M
-
-type Map v = M.Map Ident v
-
-insert = M.insertBy leIdent
-fromListWith = M.fromListByWith leIdent
-fromList = M.fromListBy leIdent
---union = M.unionBy leIdent
-lookup = M.lookupBy leIdent
-empty = M.empty
-elems = M.elems
-toList = M.toList
--}
-
--------
-
-insert :: forall v . Ident -> v -> Map v -> Map v
-fromListWith :: forall v . (v -> v -> v) -> [(Ident, v)] -> Map v
-fromList :: forall v . [(Ident, v)] -> Map v
---union :: forall v . Map v -> Map v -> Map v
-lookup :: forall v . Ident -> Map v -> Maybe v
-empty :: forall v . Map v
-elems :: forall v . Map v -> [v]
-size :: forall v . Map v -> Int
-toList :: forall v . Map v -> [(Ident, v)]
-delete :: forall v . Ident -> Map v -> Map v
+doubleR :: forall a . Map a -> Ident -> a -> Map a -> Map a
+doubleR (Node ll _ lk lv (Node lrl _ lrk lrv lrr)) k v r = node (node ll lk lv lrl) lrk lrv (node lrr k v r)
+doubleR (Node ll _ lk lv (One        lrk lrv    )) k v r = node (node ll lk lv Nil) lrk lrv (node Nil k v r)
+doubleR _ _ _ _ = undefined
--- a/src/MicroHs/Main.hs
+++ b/src/MicroHs/Main.hs
@@ -3,7 +3,7 @@
 {-# OPTIONS_GHC -Wno-unused-do-bind #-}
 module MicroHs.Main(main) where
 import Prelude
-import qualified MicroHs.StringMapFast as M
+import qualified MicroHs.IdentMap as M
 import Data.Maybe
 import System.Environment
 import MicroHs.Compile
@@ -36,9 +36,9 @@
     mainName = qualIdent mn (mkIdent "main")
     cmdl = (mainName, ds)
     ref i = Var $ mkIdent $ "_" ++ showInt i
-    defs = M.fromList [ (unIdent n, ref i) | ((n, _), i) <- zip ds (enumFrom 0) ]
+    defs = M.fromList [ (n, ref i) | ((n, _), i) <- zip ds (enumFrom 0) ]
     findIdent n = fromMaybe (error $ "main: findIdent: " ++ showIdent n) $
-                  M.lookup (unIdent n) defs
+                  M.lookup n defs
     emain = findIdent mainName
     substv aexp =
       case aexp of
--