1--------------------------------------------------------------------------
2-- Copyright (c) 2007-2010, 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, Universit��tstasse 6, CH-8092 Zurich. Attn: Systems Group.
8--
9-- Basic Hake rule combinators
10-- 
11--------------------------------------------------------------------------
12
13module HakeTypes where
14
15import Data.Typeable
16
17data TreeRef = SrcTree | BFSrcTree | BuildTree | InstallTree
18             deriving (Show,Eq,Ord)
19
20-- Note on Abs:
21-- The first parameter is a rule referring to an absolute resource whereas the
22-- second one is converted as all other rules. Dependencies and targets are
23-- generated from the second one to.
24
25data RuleToken = In     TreeRef String String -- Input to the computation
26               | Dep    TreeRef String String -- Extra (implicit) dependency
27               | NoDep  TreeRef String String -- File that's not a dependency
28               | PreDep TreeRef String String -- One-time dependency
29               | Out    String String         -- Output of the computation
30               | Target String String         -- Target that's not involved
31               | Str String                   -- String with trailing " "
32               | NStr String                  -- Just a string               
33               | ContStr Bool String String   -- Conditional string 
34               | ErrorMsg String              -- Error message: $(error x)
35               | NL                           -- New line
36               | Abs RuleToken RuleToken      -- Absolute path rule token
37                 deriving (Show,Eq,Ord)
38
39-- Convert a rule into an absolute rule
40makeAbs :: RuleToken -> RuleToken
41makeAbs rule = Abs rule rule
42
43data HRule = Rule [ RuleToken ]
44           | Include RuleToken
45           | Error String
46           | Phony String Bool [ RuleToken ]
47           | Rules [ HRule ]
48             deriving (Show,Typeable)
49
50frArch :: RuleToken -> String
51frArch (In _ a _ ) = a
52frArch (Out a _ ) = a
53frArch (Dep _ a _ ) = a
54frArch (NoDep _ a _ ) = a
55frArch (PreDep _ a _ ) = a
56frArch (Target a _ ) = a
57frArch (Abs rule _) = frArch rule
58frArch t = ""
59
60frPath :: RuleToken -> String
61frPath (In _ _ p) = p
62frPath (Out _ p) = p
63frPath (Dep _ _ p) = p
64frPath (NoDep _ _ p) = p
65frPath (PreDep _ _ p) = p
66frPath (Target _ p) = p
67frPath (Abs rule _) = frPath rule
68frPath t = ""
69
70frTree :: RuleToken -> TreeRef
71frTree (In t _ _) = t
72frTree (Dep t _ _) = t
73frTree (NoDep t _ _) = t
74frTree (PreDep t _ _) = t
75frTree (Abs rule _) = frTree rule
76frTree t = BuildTree
77
78isFileRef :: RuleToken -> Bool
79isFileRef (Str _ ) = False
80isFileRef (NStr _ ) = False
81isFileRef (ErrorMsg _) = False
82isFileRef NL = False
83isFileRef (Abs rule _) = isFileRef rule
84isFileRef _ = True
85
86isDependency :: RuleToken -> Bool
87isDependency (In _ _ _) = True
88isDependency (Dep _ _ _) = True
89isDependency (Abs rule _) = isDependency rule
90isDependency _ = False
91
92isPredependency :: RuleToken -> Bool
93isPredependency (PreDep _ _ _) = True
94isPredependency (Abs rule _) = isPredependency rule
95isPredependency _ = False
96
97isOutput :: RuleToken -> Bool
98isOutput (Out _ _) = True
99isOutput (Target _ _) = True
100isOutput (Abs rule _) = isOutput rule
101isOutput _ = False
102
103formatToken :: RuleToken -> String
104formatToken (In _ a f) = f ++ " "
105formatToken (Out a f) = f ++ " "
106formatToken (Dep _ a f) = f ++ " "
107formatToken (NoDep _ a f) = f ++ " "
108formatToken (PreDep _ a f) = f ++ " "
109formatToken (Target a f) = f ++ " "
110formatToken (Str s) = s ++ " "
111formatToken (NStr s) = s 
112formatToken (Abs rule _) = formatToken rule
113formatToken (ErrorMsg s) = "$(error " ++ s ++ ")"
114formatToken (NL) = "\n\t"
115
116-------------------------------------------------------------------------
117--
118-- Data type for default options to compilers, assemblers, dependency
119-- generators, and the like
120--
121-------------------------------------------------------------------------
122
123data OptionsPath = OptionsPath {
124    optPathBin :: String,
125    optPathLib :: String
126}
127
128data Options = Options {
129      optArch :: String,
130      optArchFamily :: String,
131      optFlags :: [RuleToken],
132      optCxxFlags :: [RuleToken],
133      optDefines :: [RuleToken],
134      optIncludes :: [RuleToken],
135      optDependencies :: [RuleToken],
136      optLdFlags :: [RuleToken],
137      optLdCxxFlags :: [RuleToken],
138      optLibs :: [RuleToken],
139      optCxxLibs :: [RuleToken],
140      optInterconnectDrivers :: [String],
141      optFlounderBackends :: [String],
142      extraFlags :: [String],
143      extraCxxFlags :: [String],
144      extraDefines :: [String],
145      extraIncludes :: [RuleToken],
146      extraDependencies :: [RuleToken],
147      extraLdFlags :: [RuleToken],
148      optSuffix :: String,
149      optInstallPath :: OptionsPath
150    }
151      
152