1%if false
2  Copyright (c) 2009 ETH Zurich.
3  All rights reserved.
4
5  This file is distributed under the terms in the attached LICENSE file.
6  If you do not find this file, copies can be found by writing to:
7  ETH Zurich D-INFK, Haldeneggsteig 4, CH-8092 Zurich. Attn: Systems Group.
8%endif
9
10> {-# LANGUAGE BangPatterns #-}
11
12
13> module Main where
14
15> import System.Environment
16> import System.Exit
17> import System.Console.GetOpt
18> import System.IO
19> import System.FilePath.Posix
20
21> import qualified Data.Map as Map
22
23> import Debug.Trace
24
25> import HamletBackend hiding (strict)
26> import HamletAst hiding (vcat')
27> import Parser
28
29> import Expressions
30> import Compile
31> import PureExpressions
32> import Constructs.Enumerations
33> import IL.Paka.Paka
34> import IL.Paka.Syntax
35> import IL.Paka.Compile 
36
37> main :: IO ()
38> main =
39>    do
40>    argv <- System.Environment.getArgs
41>    case argv of
42>      [inputFile, filenameDefs, filenameCode, filenameUserCode] -> do
43>              input <- parseCaps inputFile
44>              case input of
45>                Left err ->
46>                    do
47>                    hPutStrLn stderr "parse error at: "
48>                    hPutStrLn stderr (show err) 
49>                    exitWith (ExitFailure 1)
50>                Right ast ->
51>                    do  
52
53>                    let compiledCode = (compile $! (backend $! ast))
54>                    fileDefs <- openFile filenameDefs WriteMode
55>                    hPutStrLn fileDefs "#ifndef CAPBITS_H"
56>                    hPutStrLn fileDefs "#define CAPBITS_H"
57>                    hPutStrLn fileDefs "#include <barrelfish_kpi/capabilities.h>"
58>                    hPutStrLn fileDefs "#pragma pack(1)"
59>                    hPutStrLn fileDefs $! show $ vcat' $ extractM $ types compiledCode
60>                    hPutStrLn fileDefs $! show $ vcat' $ extractL $ declarations compiledCode
61>                    hPutStrLn fileDefs "#pragma pack(0)"
62>                    hPutStrLn fileDefs "#endif // CAPBITS_H"
63>                    hClose fileDefs
64>
65>                    fileC <- openFile filenameCode WriteMode
66>                    hPutStrLn fileC "#include <kernel.h>"
67>                    hPutStrLn fileC "#include <capabilities.h>"
68>                    hPutStrLn fileC "#include <cap_predicates.h>"
69>                    hPutStrLn fileC "#include <offsets.h>"
70>                    hPutStrLn fileC $! show $ compiledCode {declarations = [], 
71>                                                            types = Map.empty,
72>                                                            prototypes = Map.empty}
73>                    hClose fileC
74>
75>                    let compiledCode = (compile $! (userbackend $! ast))
76>                    fileC <- openFile filenameUserCode WriteMode
77>                    hPutStrLn fileC "#include <barrelfish/barrelfish.h>"
78>                    hPutStrLn fileC "#include <barrelfish_kpi/capbits.h>"
79>                    hPutStrLn fileC "#include <barrelfish/cap_predicates.h>"
80>                    hPutStrLn fileC $! show $ compiledCode {declarations = [], 
81>                                                            types = Map.empty,
82>                                                            prototypes = Map.empty}
83>                    hClose fileC
84>
85>      _ -> do
86>            hPutStrLn stderr "Usage: hamlet INPUT_CAPDEFS.hl OUTPUT_DEFS.h OUTPUT_CODE.c OUTPUT_USERCODE.c"
87>            exitWith (ExitFailure 1)
88
89