shithub: MicroHs

Info  •  Files  •  Log  •  Branches

Small tweaks

--- a/src/MicroHs/Lex.hs

+++ b/src/MicroHs/Lex.hs

@@ -68,7 +68,6 @@

 lexTop :: String -> [Token]

 lexTop = layout [] .

-         --take 10 .

          lex (mkLoc 1 1)

 lex :: Loc -> String -> [Token]

@@ -77,11 +76,10 @@

 lex loc ('\r':cs) = lex loc cs

 lex loc ('{':'-':cs) = skipNest (addCol loc 2) 1 cs

 lex loc ('-':'-':cs) | isComm rs = skipLine (addCol loc $ 2+length ds) cs

-  where {

-    (ds, rs) = span (eqChar '-') cs;

-    isComm [] = True;

+  where

+    (ds, rs) = span (eqChar '-') cs

+    isComm [] = True

     isComm (d:_) = not (isOperChar d)

-    }

 lex loc (d:cs) | isLower_ d =

   case span isIdentChar cs of

     (ds, rs) -> tIdent loc [] (d:ds) (lex (addCol loc $ 1 + length ds) rs)

@@ -100,8 +98,10 @@

   case takeChars loc (TString loc) '"' 0 [] cs of

     (t, n, rs) -> t : lex (addCol loc $ 2 + n) rs

 lex loc ('\'':cs) =

-  case takeChars loc (TChar loc . head) '\'' 0 [] cs of  -- XXX head of

-    (t, n, rs) -> t : lex (addCol loc $ 2 + n) rs

+  let tchar [c] = TChar loc c

+      tchar _ = TError loc "Illegal Char literal"

+  in  case takeChars loc tchar '\'' 0 [] cs of  -- XXX head of

+        (t, n, rs) -> t : lex (addCol loc $ 2 + n) rs

 lex loc (d:_) = [TError loc $ "Unrecognized input: " ++ showChar d]

 lex _ [] = []

@@ -110,9 +110,9 @@

 skipNest loc 0 cs           = lex loc cs

 skipNest loc n ('{':'-':cs) = skipNest (addCol loc 2) (n + 1) cs

 skipNest loc n ('-':'}':cs) = skipNest (addCol loc 2) (n - 1) cs

-skipNest loc n ('\n':cs)    = skipNest (incrLine loc)  n     cs

-skipNest loc n ('\r':cs)    = skipNest loc             n     cs

-skipNest loc n (_:cs)       = skipNest (addCol loc 1)  n     cs

+skipNest loc n ('\n':cs)    = skipNest (incrLine loc)  n      cs

+skipNest loc n ('\r':cs)    = skipNest loc             n      cs

+skipNest loc n (_:cs)       = skipNest (addCol loc 1)  n      cs

 skipNest loc _ []           = [TError loc "Unclosed {- comment"]

 -- Skip a -- style comment

--- a/src/MicroHs/Translate.hs

+++ b/src/MicroHs/Translate.hs

@@ -14,7 +14,7 @@

 --Yimport PrimTable

 import MicroHs.Desugar

-import MicroHs.Expr --X(Lit(..))

+import MicroHs.Expr

 import MicroHs.Exp

 import MicroHs.Ident

--- a/src/Text/ParserComb.hs

+++ b/src/Text/ParserComb.hs

@@ -21,8 +21,6 @@

   ) where

 --Ximport Prelude()

 import PreludeNoIO

---import Debug.Trace

---import Compat

 data LastFail t

   = LastFail Int [t] [String]

@@ -66,8 +64,6 @@

         let { xss = [ runP (k a) u | au <- aus, let { (a, u) = au } ] }

         in  case unzip [ (rs, lf) | xs <- xss, let { Many rs lf = xs } ] of

               (rss, lfs) -> Many (concat rss) (longests (plf : lfs))

-

--- XXX needs (x,y) <- e

 infixl 1 >>

 (>>) :: forall s t a b . Prsr s t a -> Prsr s t b -> Prsr s t b

-- 

⑨