shithub: MicroHs

--- a/TODO

+++ b/TODO

@@ -42,10 +42,9 @@

 * instance Bits ...

 * Split eval.c

 * Implement defaulting

-* Add location to file not found

 Bugs

  * Removing [] from prim table

  * :reload doesn't show error message

  * default methods not exported

\ No newline at end of file

+ * errtest broken

--- a/src/MicroHs/Compile.hs

+++ b/src/MicroHs/Compile.hs

@@ -119,7 +119,7 @@

   t1 <- liftIO getTimeMilli

let

     fn = map (\ c -> if c == '.' then '/' else c) (unIdent nm) ++ ".hs"

-  (pathfn, file) <- liftIO (readFilePath (paths flags) fn)

+  (pathfn, file) <- liftIO (readFilePath (getSLoc nm) (paths flags) fn)

   let mdl@(EModule nmn _ defs) = parseDie pTop pathfn file

   -- liftIO $ putStrLn $ showEModule mdl

   -- liftIO $ putStrLn $ showEDefs defs

@@ -144,11 +144,11 @@

 ------------------

-readFilePath :: [FilePath] -> FilePath -> IO (FilePath, String)

-readFilePath path name = do

+readFilePath :: SLoc -> [FilePath] -> FilePath -> IO (FilePath, String)

+readFilePath loc path name = do

   mh <- openFilePath path name

   case mh of

-    Nothing -> error $ "File not found: " ++ show name ++ "\npath=" ++ show path

+    Nothing -> errorMessage loc $ "File not found: " ++ show name ++ "\npath=" ++ show path

     Just (fn, h) -> do

       file <- hGetContents h

       return (fn, file)

--- a/src/MicroHs/Ident.hs

+++ b/src/MicroHs/Ident.hs

@@ -137,4 +137,6 @@

 showSLoc :: SLoc -> String

 showSLoc (SLoc fn l c) =

   if null fn then "no location" else

-  show fn ++ ": " ++ "line " ++ show l ++ ", col " ++ show c

+  show fn ++

+    if l == 0 && c == 0 then ""

+    else ": line " ++ show l ++ ", col " ++ show c

--- a/src/MicroHs/Main.hs

+++ b/src/MicroHs/Main.hs

@@ -28,7 +28,7 @@

                   (elem "-l" args)

   case ss of

     [] -> mainInteractive flags

-    [s] -> mainCompile flags (mkIdent s)

+    [s] -> mainCompile flags (mkIdentSLoc (SLoc "command-line" 0 0) s)

     _ -> error "Usage: mhs [-v] [-r] [-iPATH] [-oFILE] [ModuleName]"

 mainCompile :: Flags -> Ident -> IO ()

--- a/tests/errmsg.test

+++ b/tests/errmsg.test

@@ -19,7 +19,7 @@

 import Prelude

 x = y

 -----

-mhs: "../tmp/E.hs": line 4, col 1: no type signature: x

+mhs: "../tmp/E.hs": line 4, col 1: undefined type signature: x

 =====

 module E() where

@@ -27,7 +27,7 @@

 x :: Int

 x = y

 -----

-mhs: "../tmp/E.hs": line 5, col 5: undefined value identifier: y

+mhs: "../tmp/E.hs": line 5, col 5: undefined value: y

 =====

 module E() where

@@ -35,24 +35,15 @@

 x :: Int

 x = A

 -----

-mhs: "../tmp/E.hs": line 5, col 5: undefined value identifier: A

+mhs: "../tmp/E.hs": line 5, col 5: undefined value: A

 =====

 module E() where

 import Prelude

-import Control.Monad.State.Strict

-x :: Int

-x = fmap

------

-mhs: "../tmp/E.hs": line 6, col 5: ambiguous value identifier: fmap

-=====

-module E() where

-import Prelude

 x :: T

 x = 1

 -----

-mhs: "../tmp/E.hs": line 4, col 6: undefined type identifier: T

+mhs: "../tmp/E.hs": line 4, col 6: undefined type: T

 =====

 module E() where

@@ -60,7 +51,7 @@

 x :: a

 x = 1

 -----

-mhs: "../tmp/E.hs": line 4, col 6: undefined type identifier: a

+mhs: "../tmp/E.hs": line 4, col 6: undefined type: a

 =====

 module E() where

@@ -72,7 +63,7 @@

 x :: Int

 x = 3

 -----

-mhs: "../tmp/E.hs": line 2, col 8: duplicate definition E.x

+mhs: "../tmp/E.hs": line 5, col 1: duplicate definition E.x

 =====

 module E() where

@@ -85,23 +76,16 @@

 mhs: "../tmp/E.hs": line 6, col 8: bad synonym use

 =====

-module E(fmap) where

-import Prelude

-import Control.Monad.State.Strict

+module E(module M1) where

 -----

-mhs: "../tmp/E.hs": line 2, col 10: ambiguous export fmap

+mhs: "../tmp/E.hs": line 2, col 17: export undefined M1

 =====

-module E(module M) where

+module E(M2) where

 -----

-mhs: "../tmp/E.hs": line 2, col 17: export undefined M

+mhs: "../tmp/E.hs": line 2, col 10: export undefined M2

 =====

-module E(M) where

------

-mhs: "../tmp/E.hs": line 2, col 10: export undefined M

-=====

 module E() where

 import Prelude

 infixl 5 +++

@@ -121,7 +105,7 @@

 a :: Int

 a = 'a'

 -----

-mhs: "../tmp/E.hs": line 5, col 5: type error: cannot unify Primitives.Char and Primitives.Int

+mhs: "../tmp/E.hs": line 5, col 5: type error: cannot unify Char and Int

 =====

 module E() where

@@ -128,7 +112,7 @@

 import Prelude

 data T = C Maybe

 -----

-mhs: "../tmp/E.hs": line 4, col 12: kind error: cannot unify Primitives.Type and (a0 -> a1)

+mhs: "../tmp/E.hs": line 4, col 12: kind error: cannot unify Type and (a2 -> a3)

 =====

END

--

⑨