1{-
2  SkateDeclarationTable: List of all declarations
3
4  Part of Skate: a Schema specification languge
5
6  Copyright (c) 2017, ETH Zurich.
7  All rights reserved.
8
9  This file is distributed under the terms in the attached LICENSE file.
10  If you do not find this file, copies can be found by writing to:
11  ETH Zurich D-INFK, Universit\"atstr. 6, CH-8092 Zurich. Attn: Systems Group.
12-}
13
14
15module SkateDeclarationTable where
16
17
18import Data.List
19
20import System.IO
21import System.IO.Error
22import Text.Printf
23
24import SkateParser
25import SkateTypes
26import qualified SkateTypeTable as TT
27
28data Rec = Rec {
29    name :: String
30}
31
32data DeclarationTable = DTRec [Declaration] [Declaration] [Declaration] [Declaration] [Declaration]
33
34{-
35==============================================================================
36= Public Functions
37==============================================================================
38-}
39
40make_table :: Schema -> [TT.TTEntry] -> IO DeclarationTable
41make_table s@(Schema n d decls imps _) ttbl = do {
42    printf "Creating DeclarationTable.\n";
43    print (show facts);
44    print (show namespaces);
45    print (show flags);
46    print (show constants);
47    print (show enumerations);
48    return (DTRec namespaces facts flags constants enumerations)
49}
50    where
51        fdecls = flatten_decl_tree n [] decls;
52        facts = filter fact_filter fdecls;
53        namespaces = filter namespace_filter fdecls;
54        flags = filter flags_filter fdecls;
55        constants = filter constants_filter fdecls;
56        enumerations = filter enumeration_filter fdecls;
57        -- fact_flattened = [flatten_fact_type de facts ttbl | de <- facts]
58
59
60
61
62{-
63==============================================================================
64= Module Private Functions
65==============================================================================
66-}
67
68
69
70{- filter functions -}
71fact_filter :: Declaration -> Bool
72fact_filter d@(Fact _ _ _ _) = True
73fact_filter _ = False
74
75namespace_filter :: Declaration -> Bool
76namespace_filter d@(Namespace _ _ _ _) = True
77namespace_filter _ = False
78
79flags_filter :: Declaration -> Bool
80flags_filter d@(Flags _ _ _ _ _) = True
81flags_filter _ = False
82
83constants_filter :: Declaration -> Bool
84constants_filter d@(Constants _ _ _ _ _) = True
85constants_filter _ = False
86
87enumeration_filter :: Declaration -> Bool
88enumeration_filter d@(Enumeration _ _ _ _) = True
89enumeration_filter _ = False
90
91
92{- recursively go over the declaration list -}
93flatten_decl_tree :: String -> [Declaration] -> [Declaration] -> [Declaration]
94flatten_decl_tree p t (xs:x) = (flatten_decl_tree p ((parseType p t xs)) x)
95flatten_decl_tree p t [] = t
96
97
98{- handles each declaration and adds a type  -}
99parseType :: String -> [Declaration] -> Declaration -> [Declaration]
100parseType p t x@(Fact i d a _) = t ++ [x]
101parseType p t x@(Flags i d w f _) = t ++ [x]
102parseType p t x@(Constants i d a w _) = t ++ [x]
103parseType p t x@(Enumeration i d e _) = t ++ [x]
104parseType p t x@(Namespace i d decls _) = flatten_decl_tree i (t ++ [x]) decls
105parseType p t x@(Section _ decls _) = flatten_decl_tree p t decls
106parseType p t x@(Text _ _) = t
107
108
109{- -}
110
111find_fact_filter:: String -> Declaration -> Bool
112find_fact_filter i d@(Fact id _ _ _) = (i == id)
113find_fact_filter _ _ = False
114
115flatten_one_attribute :: FactAttrib -> [Declaration] -> [TT.TTEntry]-> [FactAttrib]
116flatten_one_attribute a@(FactAttrib i d tr@(TEnum ti _) p) facts ttbl = [a]
117flatten_one_attribute a@(FactAttrib i d tr@(TConstant ti _) p) facts ttbl = [a]
118flatten_one_attribute a@(FactAttrib i d tr@(TBuiltIn ti) p) facts ttbl = [a]
119flatten_one_attribute a@(FactAttrib i d tr@(TFlags ti _) p) facts ttbl = [a]
120flatten_one_attribute a@(FactAttrib i d tr@(TFact ti _ ) p) facts ttbl = flat
121    where
122        f@(Fact fi fd fa fp) = head $ filter (find_fact_filter ti) facts;
123        flat = concat $ [flatten_one_attribute at facts ttbl | at <- fa]
124
125flatten_fact_type :: Declaration -> [Declaration] -> [TT.TTEntry] -> Declaration
126flatten_fact_type de@(Fact i d a p) facts ttbl = Fact i d a2 p
127    where
128        a2 = concat $ [flatten_one_attribute attr facts ttbl | attr <- a]
129