skate: initial parts fo the C header backend
authorReto Achermann <reto.achermann@inf.ethz.ch>
Thu, 4 May 2017 15:47:29 +0000 (17:47 +0200)
committerReto Achermann <reto.achermann@inf.ethz.ch>
Thu, 4 May 2017 15:47:29 +0000 (17:47 +0200)
Signed-off-by: Reto Achermann <reto.achermann@inf.ethz.ch>

tools/skate/Main.hs
tools/skate/SkateBackendCode.hs
tools/skate/SkateBackendHeader.hs
tools/skate/SkateBackendLatex.hs
tools/skate/SkateBackendWiki.hs
tools/skate/SkateTypes.hs

index d103142..3ad9637 100644 (file)
@@ -141,7 +141,7 @@ compilerOpts argv =
     (_,_,errs) -> usageError errs
 
 
-getGenerator :: Options -> Target -> String -> String -> SkateParser.Schema -> String
+getGenerator :: Options -> Target -> String -> String -> SkateSchema.SchemaRecord -> String
 getGenerator _ Header = SkateBackendHeader.compile
 getGenerator _ Code = SkateBackendCode.compile
 getGenerator _ Latex = SkateBackendLatex.compile
@@ -150,7 +150,7 @@ getGenerator _ Wiki = SkateBackendWiki.compile
 
 
 {- compile the backend codes -}
-compile :: Options -> Target -> SkateParser.Schema -> String -> String
+compile :: Options -> Target -> SkateSchema.SchemaRecord -> String -> String
            -> Handle -> IO ()
 compile opts fl ast infile outfile outfiled =
     hPutStr outfiled $ (getGenerator opts fl) infile outfile ast
@@ -210,14 +210,9 @@ main = do {
             dfl  <- resolveImp [ast] (opt_includes opts);
             st <- SkateSchema.make_schema_record ast (tail dfl);
             printf "output parsing '%s'\n" outFile;
-            let
-                ast2 = SkateSchema.skateSchemaGetAst st;
-            in
-                do {
-                    _ <- SkateChecker.run_all_checks inFile st;
-                    outFileD <- openFile outFile WriteMode;
-                    compile opts target ast2 inFile outFile outFileD;
-                    hClose outFileD
-                }
+            _ <- SkateChecker.run_all_checks inFile st;
+            outFileD <- openFile outFile WriteMode;
+            compile opts target st inFile outFile outFileD;
+            hClose outFileD
         }
     }
index 16efec3..da30e61 100644 (file)
@@ -1,15 +1,15 @@
-{- 
+{-
   SkateBackendCode: The C code backend for Skate
-   
+
   Part of Skate: a Schema specification languge
-   
+
   Copyright (c) 2017, ETH Zurich.
   All rights reserved.
-  
+
   This file is distributed under the terms in the attached LICENSE file.
   If you do not find this file, copies can be found by writing to:
   ETH Zurich D-INFK, Universit\"atstr. 6, CH-8092 Zurich. Attn: Systems Group.
--}  
+-}
 
 module SkateBackendCode where
 
@@ -21,8 +21,9 @@ import qualified SkateParser
 import qualified CAbsSyntax as C
 
 import SkateBackendCommon
+import SkateSchema
 
 
-compile :: String -> String -> SkateParser.Schema -> String
-compile infile outfile schema = 
+compile :: String -> String -> SchemaRecord -> String
+compile infile outfile schema =
     ""
index f7866cd..fd55e4f 100644 (file)
@@ -1,15 +1,15 @@
-{- 
+{-
   SkateBackendHeader: Backend for generating C header files
-   
+
   Part of Skate: a Schema specification languge
-   
+
   Copyright (c) 2017, ETH Zurich.
   All rights reserved.
-  
+
   This file is distributed under the terms in the attached LICENSE file.
   If you do not find this file, copies can be found by writing to:
   ETH Zurich D-INFK, Universit\"atstr. 6, CH-8092 Zurich. Attn: Systems Group.
--} 
+-}
 
 module SkateBackendHeader where
 
@@ -18,16 +18,139 @@ import Data.Char
 
 import qualified CAbsSyntax as C
 import SkateParser
-
+import SkateSchema
+import SkateTypes
 
 import SkateBackendCommon
 
 
-compile :: String -> String -> SkateParser.Schema -> String
-compile infile outfile schema = 
-    ""
 
+compile :: String -> String -> SchemaRecord -> String
+compile infile outfile s = unlines $ C.pp_unit $ skate_header_file s infile
+
+skate_header_file :: SchemaRecord -> String -> C.Unit
+skate_header_file sr infile =
+    let
+        Schema n d decls imps = (schema sr)
+        sym = "SKATE__" ++ (map toUpper n) ++ "_SCHEMA_H_"
+    in
+      C.IfNDef sym ([ C.Define sym [] "1"] ++ (skate_header_body sr infile)) []
+
+{-----------------------------------------------------------------------------
+- The Header File
+------------------------------------------------------------------------------}
+
+skate_header_body :: SchemaRecord -> String -> [ C.Unit ]
+skate_header_body sr infile =
+    let
+        Schema n d decls imps = (schema sr)
+    in
+    [C.Blank, C.Blank] ++
+    [(skate_c_preamble n d)] ++
+    [C.Blank, C.Blank] ++
+    (skate_c_headerfiles imps) ++
+    [C.Blank, C.Blank] ++
+    [C.MultiComment [
+        "====================================================================",
+        "Flags",
+        "===================================================================="
+    ], C.Blank] ++
+    (skate_c_header_decls (flags sr)) ++
+    [C.Blank, C.Blank] ++
+    [C.MultiComment [
+        "====================================================================",
+        "Constants",
+        "===================================================================="
+    ], C.Blank] ++
+    (skate_c_header_decls (constants sr)) ++
+    [C.Blank, C.Blank] ++
+    [C.MultiComment [
+        "====================================================================",
+        "Enumerations",
+        "===================================================================="
+    ], C.Blank] ++
+    (skate_c_header_decls (enumerations sr)) ++
+    [C.Blank, C.Blank] ++
+    [C.MultiComment [
+        "====================================================================",
+        "Facts",
+        "===================================================================="
+    ], C.Blank] ++
+    (skate_c_header_decls (facts sr)) ++
+    [C.Blank, C.Blank]
+
+
+{-----------------------------------------------------------------------------
+- Premable and Imports
+------------------------------------------------------------------------------}
+
+skate_c_preamble :: String -> String -> C.Unit
+skate_c_preamble n d = C.MultiComment [
+    "SCHEMA DEFINITION: " ++ (map toUpper d) ++ " (" ++ n ++ ")",
+    "",
+    "Copyright (c) 2017, ETH Zurich.",
+    "All rights reserved.",
+    "",
+    "This file is distributed under the terms in the attached LICENSE",
+    "file. If you do not find this file, copies can be found by",
+    "writing to:",
+    "ETH Zurich D-INFK, Universitaetstr. 6, CH-8092 Zurich.",
+    "Attn: Systems Group.",
+    "",
+    "THIS FILE IS AUTOMATICALLY GENERATED BY SKATE: DO NOT EDIT!"];
+
+-- Header files info
+skate_c_headerfiles :: [String] -> [ C.Unit ]
+skate_c_headerfiles [] = [C.MultiComment ["No Imports"]]
+skate_c_headerfiles imps = [C.MultiComment ["Imports"]] ++
+    map (C.Include C.Standard) [ i ++ "_sks.h" | i <- imps ]
+
+
+{-----------------------------------------------------------------------------
+- Premable and Imports
+------------------------------------------------------------------------------}
+
+skate_c_header_fact :: String -> String -> [ FactAttrib ]-> [C.Unit]
+skate_c_header_fact d i attrib = [
+    C.MultiComment ["fact"]]
+
+skate_c_header_one_flag :: String -> FlagDef -> C.TypeSpec -> C.Unit
+skate_c_header_one_flag p f@(FlagDef i d v) t = C.UnitList [
+    C.DoxyComment d,
+    C.Define (flagdef) [] ("(" ++ (
+        C.pp_expr $ C.Cast t $ C.Binary C.LeftShift (C.NumConstant 1) (C.NumConstant v)) ++ ")")
+--    C.Define (sym) [] C.Ex LeftShift (C.Cast t (NumConstant 1) ) v
+    ]
+        where
+            flag = make_qualified_type p i
+            flagdef = map toUpper (make_qualified_name flag)
+
+
+skate_c_header_flags :: String -> String -> Integer ->[ FlagDef ]-> [C.Unit]
+skate_c_header_flags i d w defs = [
+    C.MultiDoxy [
+        "@brief Flags " ++ d
+    ],
+    C.TypeDef (C.TypeName "uint8_t") (make_type_name (make_qualified_name i))
+    ] ++ [skate_c_header_one_flag i def (C.TypeName "uint8_t") | def <- defs]
+    where
+        ttype = "uint" ++ show(w) ++ "_t"
+
+
+skate_c_header_const :: String -> String -> TypeRef ->[ ConstantDef ] -> [C.Unit]
+skate_c_header_const d i t defs = [C.MultiComment ["const"]]
+
+skate_c_header_enum :: String -> String -> [ EnumDef ] -> [C.Unit]
+skate_c_header_enum d i defs = [C.MultiComment ["enum"]]
 
 
+skate_c_header_one_decl :: Declaration -> [ C.Unit ]
+skate_c_header_one_decl de@(Fact i d a) = skate_c_header_fact i d a
+skate_c_header_one_decl de@(Flags i d w f) = skate_c_header_flags i d w f
+skate_c_header_one_decl de@(Constants i d t f) = skate_c_header_const i d t f
+skate_c_header_one_decl de@(Enumeration i d f) = skate_c_header_enum i d f
+skate_c_header_one_decl _  = []
 
 
+skate_c_header_decls :: [Declaration] -> [ C.Unit ]
+skate_c_header_decls decls = [C.UnitList $ skate_c_header_one_decl d | d <- decls]
index ae7e6bf..dbc4b85 100644 (file)
@@ -1,20 +1,21 @@
-{- 
+{-
   SkateBackendLatex: Backend to generate a Latex documentation
-   
+
   Part of Skate: a Schema specification languge
-   
+
   Copyright (c) 2017, ETH Zurich.
   All rights reserved.
-  
+
   This file is distributed under the terms in the attached LICENSE file.
   If you do not find this file, copies can be found by writing to:
   ETH Zurich D-INFK, Universit\"atstr. 6, CH-8092 Zurich. Attn: Systems Group.
--} 
+-}
 
 module SkateBackendLatex    where
 
 import qualified SkateParser
+import SkateSchema
 
-compile :: String -> String -> SkateParser.Schema -> String
-compile infile outfile schema = 
-    ""
\ No newline at end of file
+compile :: String -> String -> SchemaRecord -> String
+compile infile outfile schema =
+    ""
index 6397f5b..dac20e9 100644 (file)
@@ -25,13 +25,15 @@ import  SkateParser
 import SkateTypes
 import qualified AbsSyntaxWiki as W
 import SkateTypes
+import SkateSchema
 
 
 {- starts the compilation process of the schema -}
-compile :: String -> String -> Schema -> String
-compile infile outfile s@(Schema sname sdesc decls imps) =
+compile :: String -> String -> SchemaRecord -> String
+compile infile outfile sr =
     h ++ i ++ W.lineBreak ++ b ++ W.lineBreak ++ f
     where
+        Schema sname sdesc decls imps = (schema sr)
         h = wikiHeader sname sdesc infile
         i = wikiImports imps
         b = wikiBody decls sname
index c0f7ef6..a77c08d 100644 (file)
@@ -150,3 +150,12 @@ builtin_get_bits (Char)    = 8
 make_qualified_type :: String -> String -> String
 make_qualified_type "" i = i
 make_qualified_type q i = q ++ "." ++ i
+
+make_qualified_name :: [Char] -> [Char]
+make_qualified_name [] = []
+make_qualified_name (xs:x) =
+    if xs == '.' then '_' : make_qualified_name x
+    else xs : make_qualified_name x
+
+make_type_name :: String -> String
+make_type_name s = s ++ "_t"