utils/ext-core/ParseGlue.hs

   1 module ParseGlue where
   2
   3 import Encoding
   4
   5 import Data.List
   6
   7 data ParseResult a = OkP a | FailP String
   8 type P a = String -> Int -> ParseResult a
   9
  10 instance Show a => Show (ParseResult a)
  11   where show (OkP r) = show r
  12         show (FailP s) = s
  13
  14 thenP :: P a -> (a -> P b) -> P b
  15 m `thenP`  k = \ s l ->
  16   case m s l of
  17     OkP a -> k a s l
  18     FailP s -> FailP s
  19
  20 returnP :: a -> P a
  21 returnP m _ _ = OkP m
  22
  23 failP :: String -> P a
  24 failP s s' _ = FailP (s ++ ":" ++ s')
  25
  26 data Token =
  27    TKmodule
  28  | TKdata
  29  | TKnewtype
  30  | TKforall
  31  | TKrec
  32  | TKlet
  33  | TKin
  34  | TKcase
  35  | TKof
  36  | TKcast
  37  | TKnote
  38  | TKexternal
  39  | TKwild
  40  | TKoparen
  41  | TKcparen
  42  | TKobrace
  43  | TKcbrace
  44  | TKhash
  45  | TKeq
  46  | TKcoloncolon
  47  | TKstar
  48  | TKrarrow
  49  | TKlambda
  50  | TKbiglambda
  51  | TKat
  52  | TKdot
  53  | TKcolon
  54  | TKquestion
  55  | TKsemicolon
  56  | TKname String
  57  | TKcname String
  58  | TKinteger Integer
  59  | TKrational Rational
  60  | TKstring String
  61  | TKchar Char
  62  | TKEOF
  63
  64 -- ugh
  65 splitModuleName mn =
  66    let decoded = zDecodeString mn
  67        -- Triple ugh.
  68        -- We re-encode the individual parts so that:
  69        -- main:Foo_Bar.Quux.baz
  70        -- prints as:
  71        -- main:FoozuBarziQuux.baz
  72        -- and not:
  73        -- main:Foo_BarziQuux.baz
  74        parts   = map zEncodeString $ filter (notElem '.') $ groupBy
  75                    (\ c1 c2 -> c1 /= '.' && c2 /= '.')
  76                  decoded in
  77      (take (length parts - 1) parts, last parts)
  78
  79
  80
  81
  82
  83
  84
  85
  86
  87