diff options
author | Péter Diviánszky <divipp@gmail.com> | 2016-05-12 23:55:35 +0200 |
---|---|---|
committer | Péter Diviánszky <divipp@gmail.com> | 2016-05-12 23:55:35 +0200 |
commit | 7310e4916b8ee7d96db0e64e75ab98499a826674 (patch) | |
tree | fbcb77a6383a15598a924714abcf97c71b73e1ac /src | |
parent | 67304cc71d2f0efa76b2b2a46575230a5102c6a0 (diff) |
don't show module path
Diffstat (limited to 'src')
-rw-r--r-- | src/LambdaCube/Compiler.hs | 4 | ||||
-rw-r--r-- | src/LambdaCube/Compiler/DesugaredSource.hs | 13 |
2 files changed, 12 insertions, 5 deletions
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 | |||
141 | src <- srcm | 141 | src <- srcm |
142 | fid <- gets nextMId | 142 | fid <- gets nextMId |
143 | modify $ \(Modules nm im ni) -> Modules (Map.insert fname fid nm) im $ ni+1 | 143 | modify $ \(Modules nm im ni) -> Modules (Map.insert fname fid nm) im $ ni+1 |
144 | let fi = FileInfo fid fname src | 144 | let fi = FileInfo fid fname mname src |
145 | res <- case parseLC fi of | 145 | res <- case parseLC fi of |
146 | Left e -> return $ Left $ text $ show e | 146 | Left e -> return $ Left $ text $ show e |
147 | Right e -> do | 147 | Right e -> do |
@@ -224,7 +224,7 @@ preCompile paths paths' backend mod = do | |||
224 | where | 224 | where |
225 | compile src = runMM fetch $ do | 225 | compile src = runMM fetch $ do |
226 | let pname = "." </> "Prelude.lc" | 226 | let pname = "." </> "Prelude.lc" |
227 | modify $ \(Modules nm im ni) -> Modules (Map.insert pname ni nm) (IM.insert ni (FileInfo ni pname $ fileContent fi, prelude) im) (ni+1) | 227 | modify $ \(Modules nm im ni) -> Modules (Map.insert pname ni nm) (IM.insert ni (FileInfo ni pname "Prelude" $ fileContent fi, prelude) im) (ni+1) |
228 | (snd &&& fst) <$> compilePipeline' ex backend "Main" | 228 | (snd &&& fst) <$> compilePipeline' ex backend "Main" |
229 | where | 229 | where |
230 | fetch imp = \case | 230 | 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 | |||
71 | data FileInfo = FileInfo | 71 | data FileInfo = FileInfo |
72 | { fileId :: !Int | 72 | { fileId :: !Int |
73 | , filePath :: FilePath | 73 | , filePath :: FilePath |
74 | , fileModule :: String -- module name | ||
74 | , fileContent :: String | 75 | , fileContent :: String |
75 | } | 76 | } |
76 | 77 | ||
77 | instance Eq FileInfo where (==) = (==) `on` fileId | 78 | instance Eq FileInfo where (==) = (==) `on` fileId |
78 | instance Ord FileInfo where compare = compare `on` fileId | 79 | instance Ord FileInfo where compare = compare `on` fileId |
79 | 80 | ||
80 | instance PShow FileInfo where pShow = text . filePath | 81 | instance PShow FileInfo where pShow = text . (++ ".lc") . fileModule |
81 | 82 | ||
82 | showPos :: FileInfo -> SPos -> Doc | 83 | showPos :: FileInfo -> SPos -> Doc |
83 | showPos n p = pShow n <> ":" <> pShow p | 84 | showPos n p = pShow n <> ":" <> pShow p |
@@ -458,7 +459,6 @@ trSExp' = trSExp elimVoid | |||
458 | 459 | ||
459 | instance (HasFreeVars a, PShow a) => PShow (SExp' a) where | 460 | instance (HasFreeVars a, PShow a) => PShow (SExp' a) where |
460 | pShow = \case | 461 | pShow = \case |
461 | -- SGlobal op | Just p <- nameFixity op -> DOp0 (sName op) p | ||
462 | SGlobal ns -> pShow ns | 462 | SGlobal ns -> pShow ns |
463 | Parens x -> pShow x -- TODO: remove | 463 | Parens x -> pShow x -- TODO: remove |
464 | SAnn a b -> shAnn (pShow a) (pShow b) | 464 | 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 | |||
532 | -------------------------------------------------------------------------------- statement | 532 | -------------------------------------------------------------------------------- statement |
533 | 533 | ||
534 | data Stmt | 534 | data Stmt |
535 | = StLet SIName (Maybe SExp) SExp | 535 | = StmtLet SIName SExp |
536 | | Data SIName [(Visibility, SExp)]{-parameters-} SExp{-type-} [(SIName, SExp)]{-constructor names and types-} | 536 | | Data SIName [(Visibility, SExp)]{-parameters-} SExp{-type-} [(SIName, SExp)]{-constructor names and types-} |
537 | | PrecDef SIName Fixity | 537 | | PrecDef SIName Fixity |
538 | 538 | ||
539 | pattern StLet n mt x <- StmtLet n (getSAnn -> (x, mt)) | ||
540 | where StLet n mt x = StmtLet n $ maybe x (SAnn x) mt | ||
541 | |||
542 | getSAnn (SAnn x t) = (x, Just t) | ||
543 | getSAnn x = (x, Nothing) | ||
544 | |||
539 | pattern Primitive n t = StLet n (Just t) (SBuiltin Fundefined) | 545 | pattern Primitive n t = StLet n (Just t) (SBuiltin Fundefined) |
540 | 546 | ||
541 | instance PShow Stmt where | 547 | instance PShow Stmt where |
@@ -548,6 +554,7 @@ instance PShow Stmt where | |||
548 | instance DeBruijnify SIName Stmt where | 554 | instance DeBruijnify SIName Stmt where |
549 | deBruijnify_ k v = \case | 555 | deBruijnify_ k v = \case |
550 | StLet sn mt e -> StLet sn (deBruijnify_ k v <$> mt) (deBruijnify_ k v e) | 556 | StLet sn mt e -> StLet sn (deBruijnify_ k v <$> mt) (deBruijnify_ k v e) |
557 | x@PrecDef{} -> x | ||
551 | x -> error $ "deBruijnify @ " ++ ppShow x | 558 | x -> error $ "deBruijnify @ " ++ ppShow x |
552 | 559 | ||
553 | -------------------------------------------------------------------------------- statement with dependencies | 560 | -------------------------------------------------------------------------------- statement with dependencies |