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