← Back to branch summary

~ubuntu-branches/ubuntu/wily/agda/wily-proposed

« back to all changes in this revision

Viewing changes to src/prototyping/modules/flat/Main.hs

  • Committer: Package Import Robot
  • Author(s): Iain Lane
  • Date: 2014-08-05 06:38:12 UTC
  • mfrom: (1.1.6)
  • Revision ID: package-import@ubuntu.com-20140805063812-io8e77niomivhd49
Tags: 2.4.0.2-1
* [6e140ac] Imported Upstream version 2.4.0.2
* [2049fc8] Update Build-Depends to match control
* [93dc4d4] Install the new primitives
* [e48f40f] Fix typo dev→doc

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/prototyping/modules/flat/Main.hs
1
 
 
2
 
module Main where
3
 
 
4
 
import Control.Monad.Error
5
 
import System.Environment ( getArgs, getProgName )
6
 
 
7
 
import Syntax.Lex
8
 
import Syntax.Par
9
 
import Syntax.Print
10
 
import qualified Syntax.Abs as C
11
 
import Syntax.Layout
12
 
import Syntax.ErrM
13
 
 
14
 
import Scope
15
 
import TypeCheck
16
 
 
17
 
type ParseFun a = [Token] -> Err a
18
 
 
19
 
myLLexer = resolveLayout True . myLexer
20
 
 
21
 
type Verbosity = Int
22
 
 
23
 
putStrV :: Verbosity -> String -> IO ()
24
 
putStrV v s = if v > 1 then putStrLn s else return ()
25
 
 
26
 
runFile :: Verbosity -> ParseFun C.Decl -> FilePath -> IO ()
27
 
runFile v p f = putStrLn f >> readFile f >>= run v p
28
 
 
29
 
run :: Verbosity -> ParseFun C.Decl -> String -> IO ()
30
 
run v p s = let ts = myLLexer s in case p ts of
31
 
           Bad s    -> do putStrLn "\nParse              Failed...\n"
32
 
                          putStrV v "Tokens:"
33
 
                          putStrV v $ show ts
34
 
                          putStrLn s
35
 
           Ok  tree -> case scopeCheckProgram tree of
36
 
            Left err    -> putStrLn $ "Scope error:\n" ++ err
37
 
            Right ds    -> do
38
 
                putStrLn "\nScope OK:"
39
 
                mapM_ print ds
40
 
                case runTCM $ mapM_ checkDecl ds of
41
 
                    Left err    -> putStrLn $ "Type error:\n" ++ err
42
 
                    Right st    -> do
43
 
                        putStrLn "\nType OK:"
44
 
                        print st
45
 
 
46
 
 
47
 
 
48
 
showTree :: (Show a, Print a) => Int -> a -> IO ()
49
 
showTree v tree
50
 
 = do
51
 
      putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree
52
 
      putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree
53
 
 
54
 
main :: IO ()
55
 
main = do args <- getArgs
56
 
          case args of
57
 
            "-s":fs -> mapM_ (runFile 0 pDecl1) fs
58
 
            fs -> mapM_ (runFile 2 pDecl1) fs