External Core typechecker - improve handling of coercions

[ghc-hetmet.git] / utils / ext-core / ParseGlue.hs

diff --git a/utils/ext-core/ParseGlue.hs b/utils/ext-core/ParseGlue.hs
index 3dde0c3..2e196c0 100644 (file)
--- a/utils/ext-core/ParseGlue.hs
+++ b/utils/ext-core/ParseGlue.hs
@@ -1,8 +1,16 @@
 module ParseGlue where
 
+import Encoding
+
+import Data.List
+
 data ParseResult a = OkP a | FailP String
 type P a = String -> Int -> ParseResult a
 
+instance Show a => Show (ParseResult a)
+  where show (OkP r) = show r
+        show (FailP s) = s
+
 thenP :: P a -> (a -> P b) -> P b
 m `thenP`  k = \ s l -> 
   case m s l of 
@@ -25,7 +33,7 @@ data Token =
  | TKin 
  | TKcase 
  | TKof 
- | TKcoerce 
+ | TKcast
  | TKnote 
  | TKexternal
  | TKwild
@@ -42,6 +50,7 @@ data Token =
  | TKbiglambda
  | TKat 
  | TKdot
+ | TKcolon
  | TKquestion
  | TKsemicolon
  | TKname String 
@@ -52,7 +61,20 @@ data Token =
  | TKchar Char 
  | TKEOF
 
-
+-- ugh
+splitModuleName mn = 
+   let decoded = zDecodeString mn
+       -- Triple ugh.
+       -- We re-encode the individual parts so that:
+       -- main:Foo_Bar.Quux.baz
+       -- prints as:
+       -- main:FoozuBarziQuux.baz
+       -- and not:
+       -- main:Foo_BarziQuux.baz
+       parts   = map zEncodeString $ filter (notElem '.') $ groupBy 
+                   (\ c1 c2 -> c1 /= '.' && c2 /= '.') 
+                 decoded in
+     (take (length parts - 1) parts, last parts)