From 7310e4916b8ee7d96db0e64e75ab98499a826674 Mon Sep 17 00:00:00 2001
From: Péter Diviánszky <divipp@gmail.com>
Date: Thu, 12 May 2016 23:55:35 +0200
Subject: don't show module path

---
 src/LambdaCube/Compiler.hs                 |  4 ++--
 src/LambdaCube/Compiler/DesugaredSource.hs | 13 ++++++++++---
 2 files changed, 12 insertions(+), 5 deletions(-)

(limited to 'src')

diff --git a/src/LambdaCube/Compiler.hs b/src/LambdaCube/Compiler.hs
index 92708fba..c4a450fd 100644
--- a/src/LambdaCube/Compiler.hs
+++ b/src/LambdaCube/Compiler.hs
@@ -141,7 +141,7 @@ loadModule ex imp mname_ = do
         src <- srcm
         fid <- gets nextMId
         modify $ \(Modules nm im ni) -> Modules (Map.insert fname fid nm) im $ ni+1
-        let fi = FileInfo fid fname src
+        let fi = FileInfo fid fname mname src
         res <- case parseLC fi of
           Left e -> return $ Left $ text $ show e
           Right e -> do
@@ -224,7 +224,7 @@ preCompile paths paths' backend mod = do
       where
         compile src = runMM fetch $ do
             let pname = "." </> "Prelude.lc"
-            modify $ \(Modules nm im ni) -> Modules (Map.insert pname ni nm) (IM.insert ni (FileInfo ni pname $ fileContent fi, prelude) im) (ni+1)
+            modify $ \(Modules nm im ni) -> Modules (Map.insert pname ni nm) (IM.insert ni (FileInfo ni pname "Prelude" $ fileContent fi, prelude) im) (ni+1)
             (snd &&& fst) <$> compilePipeline' ex backend "Main"
           where
             fetch imp = \case
diff --git a/src/LambdaCube/Compiler/DesugaredSource.hs b/src/LambdaCube/Compiler/DesugaredSource.hs
index 3b615685..72327b99 100644
--- a/src/LambdaCube/Compiler/DesugaredSource.hs
+++ b/src/LambdaCube/Compiler/DesugaredSource.hs
@@ -71,13 +71,14 @@ instance PShow SPos where
 data FileInfo = FileInfo
     { fileId      :: !Int
     , filePath    :: FilePath
+    , fileModule  :: String   -- module name
     , fileContent :: String
     }
 
 instance Eq FileInfo where (==) = (==) `on` fileId
 instance Ord FileInfo where compare = compare `on` fileId
 
-instance PShow FileInfo where pShow = text . filePath
+instance PShow FileInfo where pShow = text . (++ ".lc") . fileModule
 
 showPos :: FileInfo -> SPos -> Doc
 showPos n p = pShow n <> ":" <> pShow p
@@ -458,7 +459,6 @@ trSExp' = trSExp elimVoid
 
 instance (HasFreeVars a, PShow a) => PShow (SExp' a) where
     pShow = \case
---        SGlobal op | Just p <- nameFixity op -> DOp0 (sName op) p
         SGlobal ns      -> pShow ns
         Parens x        -> pShow x     -- TODO: remove
         SAnn a b        -> shAnn (pShow a) (pShow b)
@@ -532,10 +532,16 @@ shLet_ a b = DFreshName True $ showLet (DLet "=" (shVar 0) $ DUp 0 a) b
 -------------------------------------------------------------------------------- statement
 
 data Stmt
-    = StLet SIName (Maybe SExp) SExp
+    = StmtLet SIName SExp
     | Data SIName [(Visibility, SExp)]{-parameters-} SExp{-type-} [(SIName, SExp)]{-constructor names and types-}
     | PrecDef SIName Fixity
 
+pattern StLet n mt x <- StmtLet n (getSAnn -> (x, mt))
+  where StLet n mt x =  StmtLet n $ maybe x (SAnn x) mt
+
+getSAnn (SAnn x t) = (x, Just t)
+getSAnn x = (x, Nothing)
+
 pattern Primitive n t = StLet n (Just t) (SBuiltin Fundefined)
 
 instance PShow Stmt where
@@ -548,6 +554,7 @@ instance PShow Stmt where
 instance DeBruijnify SIName Stmt where
     deBruijnify_ k v = \case
         StLet sn mt e -> StLet sn (deBruijnify_ k v <$> mt) (deBruijnify_ k v e)
+        x@PrecDef{} -> x
         x -> error $ "deBruijnify @ " ++ ppShow x
 
 -------------------------------------------------------------------------------- statement with dependencies
-- 
cgit v1.2.3