Small fixes in code integrator

currypp/IntegratedCode/TransICode.curry

@@ -26,11 +26,12 @@
 --- sql    - see the SQLConverter and CDBI-library
 ---
 --- @author Jasper Sikorra (with changes by Michael Hanus)
---- @version November 2015
+--- @version June 2016
 ------------------------------------------------------------------------------
 module TransICode where
 
 import Directory(getDirectoryContents)
+import FilePath ((</>), takeDirectory)
 import IO(stderr,hPutStrLn)
 import List
 import System
@@ -75,10 +76,12 @@ addRealFname :: Filename -> Warning -> Warning
 addRealFname f w = setWarnPos w (setFilename (getWarnPos w) f)
 
 -- Formatting and terminating with Errors
-errfun :: [PError] -> IO _
-errfun (e1:es) = do
+formatErrors :: [PError] -> IO _
+formatErrors [] =
+  error "Internal error in 'TransICode.formatErrors': No errors in list!"
+formatErrors es@(e1:_) = do
   hPutStrLn stderr $ "\nERRORS in " ++ getFilename (getPErrorPos e1) ++ ":"
-                                    ++ concatMap formatErr (e1:es)
+                                    ++ concatMap formatErr es
   error "Failure during preprocessing of Curry source file!"
  where
   formatErr :: PError -> String
@@ -110,22 +113,25 @@ formatWarnings ws@((p,_):_) = "\nWARNINGS in " ++ getFilename p ++ ":"
 --- @return The translated string
 translateIntCode :: Int -> String -> String -> String -> IO String
 translateIntCode verb model fname s = do
-  pinfo <- tryReadParserInfoFile verb model
+  pinfo <- tryReadParserInfoFile verb model fname
   stw <- concatAllIOPM $ applyLangParsers pinfo
                        $ ciparser fname s
   putStr (formatWarnings (getWarnings stw))
-  escapePR (discardWarnings stw) errfun
+  escapePR (discardWarnings stw) formatErrors
 
---- Try to read parser info file.
-tryReadParserInfoFile :: Int -> String -> IO (Either String ParserInfo)
-tryReadParserInfoFile verb model = do
+--- Try to read parser info file for the SQL preprocessor.
+tryReadParserInfoFile :: Int -> String -> String
+                      -> IO (Either String ParserInfo)
+tryReadParserInfoFile verb model orgfname = do
   if null model
-   then do dirfiles <- getDirectoryContents "." -- maybe modify?
+   then do dirfiles <- getDirectoryContents orgdir
            case filter ("_SQLCode.info" `isSuffixOf`) dirfiles of
              []  -> return (Left "No .info file provided or found!")
-             [m] -> readParserInfo verb m
+             [m] -> readParserInfo verb (orgdir </> m)
              _   -> return (Left "Multiple .info files found!")
    else readParserInfo verb model
+ where
+   orgdir = takeDirectory orgfname
 
 --- Handles the IO and PM monads around the StandardTokens for the
 --- concatenation, so they will not disturb in the real concat function

currypp/Main.curry

@@ -17,7 +17,7 @@ import AbstractCurry.Select(progName)
 import Char(isDigit,digitToInt)
 import Directory(copyFile,renameFile)
 import Distribution
-import FilePath (splitDirectories)
+import FilePath
 import List
 import System
 
@@ -38,10 +38,10 @@ data PPTarget = ForeignCode | SequentialRules | DefaultRules | Contracts
 parseTarget :: String -> Maybe PPTarget
 parseTarget t | t=="foreigncode"  = Just ForeignCode
               | t=="defaultrules" = Just DefaultRules
-	      | t=="seqrules"     = Just SequentialRules
-	      | t=="contracts"    = Just Contracts
-	      | otherwise         = Nothing
-	      
+              | t=="seqrules"     = Just SequentialRules
+              | t=="contracts"    = Just Contracts
+              | otherwise         = Nothing
+              
 --- Preprocessor options:
 data PPOpts =
   PPOpts { optHelp      :: Bool
@@ -51,18 +51,18 @@ data PPOpts =
          , optModel     :: String     -- model for the SQL preprocessor
          , optDefRules  :: [String]   -- options for DefaultRules
          , optContracts :: [String]   -- options for Contracts
-	 }
+         }
 
 initOpts :: PPOpts
 initOpts = PPOpts { optHelp      = False
                   , optSave      = False
- 	          , optVerb      = 1
-		  , optTgts      = []
+                  , optVerb      = 1
+                  , optTgts      = []
                   , optModel     = ""
-		  , optDefRules  = []
-		  , optContracts = []
-		  }
-		  
+                  , optDefRules  = []
+                  , optContracts = []
+                  }
+                  
 --- The main function of the Curry Preprocessor.
 main :: IO ()
 main = do
@@ -70,29 +70,29 @@ main = do
   case args of
     (orgSourceFile:inFile:outFile:options) ->
        maybe (showUsage args)
-	     (\opts ->
-	       if optHelp opts
-	       then putStrLn (cppBanner ++ usageText) >> exitWith 1
-	       else do
-                let modname = pathToModName (stripCurrySuffix orgSourceFile)
+             (\opts ->
+               if optHelp opts
+               then putStrLn (cppBanner ++ usageText) >> exitWith 1
+               else do
+                let modname = pathToModName orgSourceFile
                 when (optVerb opts > 1) $ putStr cppBanner
                 when (optVerb opts > 2) $ putStr $ unlines
-		  ["Module name        : " ++ modname
-		  ,"Original file name : " ++ orgSourceFile
-		  ,"Input    file name : " ++ inFile
-		  ,"Output   file name : " ++ outFile ]
+                  ["Module name        : " ++ modname
+                  ,"Original file name : " ++ orgSourceFile
+                  ,"Input    file name : " ++ inFile
+                  ,"Output   file name : " ++ outFile ]
                 preprocess opts modname orgSourceFile inFile outFile
                 when (optSave opts) $ saveFile orgSourceFile outFile
-		when (optVerb opts > 3) $ do
+                when (optVerb opts > 3) $ do
                   putStrLn "TRANSFORMED PROGRAM:"
                   putStrLn "===================="
                   readFile outFile >>= putStrLn
              )
-	     (processOptions initOpts options)
+             (processOptions initOpts options)
     _ -> maybe (showUsage args)
-	       (\opts -> if optHelp opts
-	                 then putStrLn (cppBanner ++ usageText)
-	                 else showUsage args)
+               (\opts -> if optHelp opts
+                         then putStrLn (cppBanner ++ usageText)
+                         else showUsage args)
                (processOptions initOpts args)
  where
   saveFile orgSourceFile outFile = do
@@ -109,7 +109,7 @@ processOptions opts optargs = case optargs of
     ("-v":os)         -> processOptions opts { optVerb = 2 } os
     (['-','v',vl]:os) -> if isDigit vl
                          then processOptions opts { optVerb = digitToInt vl } os
-			 else Nothing
+                         else Nothing
     (('-':'-':ts):os) -> if isPrefixOf "model:" ts
                          then processOptions 
                                 opts {optModel = tail (dropWhile (/=':') ts) }
@@ -240,12 +240,16 @@ callPreprocessors opts optlines modname srcprog orgfile outfile
 
 --- Transforms a file path name for a module back into a hierarchical module
 --- since only the file path of a module is passed to the preprocessor.
---- We assume that these are always the local file path names,
---- otherwise it is difficult to reconstruct the original module name
+--- This is done if if it is a local file path name,
+--- otherwise only theit is difficult to reconstruct the original module name
 --- from the file path.
 pathToModName :: String -> String
-pathToModName = intercalate "." . splitDirectories
-
+pathToModName psf =
+  if isRelative p
+   then intercalate "." (splitDirectories  p)
+   else takeBaseName p
+ where
+  p = stripCurrySuffix psf
 
 -- Replace OPTIONS_CYMAKE line containing currypp call
 -- in a source text by blank line (to avoid recursive calls):