removing tools/sockeye -> transition to skate
authorReto Achermann <reto.achermann@inf.ethz.ch>
Fri, 5 May 2017 07:53:28 +0000 (09:53 +0200)
committerReto Achermann <reto.achermann@inf.ethz.ch>
Fri, 5 May 2017 07:53:28 +0000 (09:53 +0200)
Signed-off-by: Reto Achermann <reto.achermann@inf.ethz.ch>

17 files changed:
tools/sockeye/Backend.lhs [deleted file]
tools/sockeye/BackendCommon.hs [deleted file]
tools/sockeye/CAbsSyntax.hs [deleted file]
tools/sockeye/CSyntax.hs [deleted file]
tools/sockeye/Hakefile [deleted file]
tools/sockeye/MachineModel.xsd [deleted file]
tools/sockeye/MachineModelCode.xsl [deleted file]
tools/sockeye/Main.lhs [deleted file]
tools/sockeye/SockeyeCodeBackend.hs [deleted file]
tools/sockeye/SockeyeDocBackend.hs [deleted file]
tools/sockeye/SockeyeHeaderBackend.hs [deleted file]
tools/sockeye/SockeyeParser.hs [deleted file]
tools/sockeye/SockeyeSyntax.lhs [deleted file]
tools/sockeye/SockeyeTools.hs [deleted file]
tools/sockeye/intro.tex [deleted file]
tools/sockeye/notes.txt [deleted file]
tools/sockeye/tutorial.lhs [deleted file]

diff --git a/tools/sockeye/Backend.lhs b/tools/sockeye/Backend.lhs
deleted file mode 100644 (file)
index b688b8c..0000000
+++ /dev/null
@@ -1,116 +0,0 @@
-%include polycode.fmt
-
-%if false
-  Sockeye: an even more simpler IDL for Barrelfish
-   
-  Copyright (c) 2015 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, Universitaetsstrasse 6, CH-8092 Zurich. 
-  Attn: Systems Group.
-%endif
-
-\section{General Functions for Back-ends}
-
-
-In this module, we define some general functions. These functions are
-used in both Code and Header back-ends. They are quite simple, so we
-can afford to present them out of their context.
-
-
-> module Backend where
-
-%if false
-
-> import Data.List
-
-> import SockeyeSyntax
-
-%endif
-
-
-
-\subsection{The Preamble}
-
-In both cases, we will have to emit a long, tedious copyright
-notice. So, here it is done once and for all.
-
-> preamble :: Schema -> String -> String
-> preamble schema filename =
->     let name = 
->             case schema of
->                    Schema _ desc _ -> desc
->                    _ -> ""
->     in
->     {-" \mbox{and so on\ldots} "-}
-
-%if false
-
->     "/*\n * Schema Definition: " ++ name ++ "\n\
->     \ * Generated from: " ++ filename ++ "\n\
->     \ * \n\
->     \ * Copyright (c) 2015, ETH Zurich.\n\
->     \ * All rights reserved.\n\
->     \ * \n\
->     \ * This file is distributed under the terms in the attached LICENSE\n\
->     \ * file. If you do not find this file, copies can be found by\n\
->     \ * writing to:\n\
->     \ * ETH Zurich D-INFK, Universitaetsstrasse 6, CH-8092 Zurich.\n\
->     \ *  Attn: Systems Group.\n\
->     \ * \n\
->     \ * THIS FILE IS AUTOMATICALLY GENERATED: DO NOT EDIT!\n\
->     \ */\n\n"
-
-%endif
-
-
-\subsection{Dealing with Namespace Issues}
-
-
-In order to avoid name clashes, we qualify type names with the
-interface name, excepted when it is a built-in type.
-
-> qualifyName :: String -> TypeRef -> String
-> qualifyName schemaName (Builtin t) = show t
-> qualifyName schemaName (TypeVar t) = schemaName ++ "_" ++ t 
-> qualifyName schemaName (TypeAlias t _) = schemaName ++ "_" ++ t
-
-When we are declarating real C types, we have to add a @_t@ at the
-end.
-
-> qualifyType :: String -> TypeRef -> String
-> qualifyType qualifier (Builtin String) = "char *"
-> qualifyType qualifier (TypeAlias name _) = name ++ "_t"
-> qualifyType qualifier typeDef =
->     qualifyName qualifier typeDef ++ "_t"
-
-When we are generating stubs, we will need to qualify exported procedures:
-@qualifyProcName@ corresponds to the interface namespace, along with a
-@_fn@ specifier.
-
-> qualifyProcName :: String -> TypeRef -> String
-> qualifyProcName schemaName typeDef = 
->     qualifyName schemaName typeDef ++ "_fn"
-
-
-
-\subsection{Dealing with Declarations}
-
-
-Often (always), we treat types and messages separately. Hence,
-@partitionTypesFacts@ takes a list of declarations and partitions
-it into two lists: one containing the type declarations, the other
-containing the message declarations.
-
-> partitionTypesFactsQueries :: [Declaration] -> ([TypeDef], [FactDef], [QueryDef])
-> partitionTypesFactsQueries declarations = 
->     let (types, facts, queries) = foldl' typeFilter ([],[],[]) declarations in
->         (types, reverse facts, reverse queries)
->         where typeFilter (types, facts, queries) (Factdef f) = (types, f : facts, queries)
->               typeFilter (types, facts, queries) (Typedef t) = (t : types, facts, queries)
->               typeFilter (types, facts, queries) (Querydef q) = (types, facts, q : queries)
-
-
-\subsection{Dealing with Messages}
diff --git a/tools/sockeye/BackendCommon.hs b/tools/sockeye/BackendCommon.hs
deleted file mode 100644 (file)
index 30d0d54..0000000
+++ /dev/null
@@ -1,169 +0,0 @@
-{- 
-   BackendCommon: Common code used by most backends
-   
-  Part of Flounder: a message passing IDL for Barrelfish
-   
-  Copyright (c) 2007-2010, 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 BackendCommon where
-
-
-import qualified CAbsSyntax as C
-import SockeyeSyntax
-import Data.Char (toUpper, isAlpha)
-
-
-------------------------------------------------------------------------
--- Language mapping: C identifier names
-------------------------------------------------------------------------
-
--- Scope a list of strings
-ifscope :: String -> String -> String
-ifscope sn s = sn ++ "__" ++ s
-
-idscope :: String -> String -> String -> String
-idscope sn s suffix  = ifscope sn (s ++ "__" ++ suffix)
-
-drvscope :: String -> String -> String -> String
-drvscope drv sn s = ifscope sn (drv ++ "_" ++ s)
-
-plscope :: String -> String -> String
-plscope sn s = sn ++ "_" ++ s
-
-fact_add_fn :: String -> String
-fact_add_fn sn = sn ++ "add"
-
-fact_exist_fn :: String -> String
-fact_exist_fn sn = sn ++ "exist"
-
-fact_remove_fn :: String -> String
-fact_remove_fn sn = sn ++ "remove"
-
--- Name of the type of a message function
-fact_sig_type :: String -> String-> FactDef -> String
-fact_sig_type sn fn f@(Fact _ _ _) = (idscope sn (fact_name f)) fn
-
--- Name of the fact attributes struct
-fact_attrib_type :: String -> FactDef -> String
-fact_attrib_type sn f@(Fact _ _ _) = ifscope sn (fact_name f)
-
-plfact_attrib_type :: String -> FactDef -> String
-plfact_attrib_type sn f@(Fact _ _ _) = plscope sn (fact_name f)
-
-fact_param_desc :: FactAttribute -> String
-fact_param_desc fa = "@param  " ++ pname ++ "   " ++ pdesc 
-  where 
-    pname = fact_args_name fa
-    pdesc = fact_args_desc fa
-
--- Name of a given message definition
-fact_name :: FactDef -> String
-fact_name (Fact n _ _) = n
-
-fact_desc :: FactDef -> String
-fact_desc (Fact _ d _) = d
-
-fact_args :: FactDef -> [FactAttribute]
-fact_args (Fact _ _ atr) = atr
-
-fact_args_name :: FactAttribute -> String
-fact_args_name (FAttrib _ (Name n) _) = n
-
-fact_args_desc :: FactAttribute -> String
-fact_args_desc (FAttrib _ _ d) = d
-
--- Name of the type of a message function
-query_sig_type :: String -> QueryDef -> String
-query_sig_type sn q@(Query _ _ _) = idscope sn (query_name q) "query"
-
-
--- Name of a given message definition
-query_name :: QueryDef -> String
-query_name (Query n _ _) = n
-
--- Name of the C type for a concrete flounder type, struct, or enum
-type_c_enum :: String -> String -> String
-type_c_enum sn e = ifscope name e
-  where
-    name = [ toUpper x | x <- sn ]
-
-type_c_define :: String -> String -> String -> String 
-type_c_define sn e mod = ifscope sname ename ++ "_" ++ mod2
-  where
-    sname = [ toUpper x | x <- sn ]
-    ename = [ toUpper x | x <- e ]  
-    mod2 = [ toUpper x | x <- mod ]
-
-type_c_name :: String -> TypeRef -> String
-type_c_name sn (Builtin String) = undefined
-type_c_name sn (Builtin t) = (show t) ++ "_t"
-type_c_name sn (TypeVar t) = type_c_name1 sn t
-type_c_name sn (TypeAlias t _) = type_c_name1 sn t
-type_c_name sn (FactType t) = type_c_name1 sn t
-
-type_c_name1 :: String -> String -> String
-type_c_name1 sn tn = (ifscope sn tn) ++ "_t"
-
-
-type_c_type :: String -> TypeRef -> C.TypeSpec
-type_c_type sn (Builtin Char) = C.TypeName "char"
-type_c_type sn (Builtin Bool) = C.TypeName "bool"
-type_c_type sn (Builtin String) = C.Ptr $ C.TypeName "char"
-type_c_type sn t = C.TypeName $ type_c_name sn t
-
-------------------------------------------------------------------------
--- Code shared by backend implementations
-------------------------------------------------------------------------
-
-schema_preamble :: String -> String -> String -> C.Unit
-schema_preamble infile name descr = 
-    C.MultiComment [ 
-          "Copyright (c) 2015, ETH Zurich.",
-          "All rights reserved.",
-          "",
-          "SCHEMA NAME: " ++ name,
-          "SCHEMA FILE: " ++ infile,
-          "SCHEMA DESCRIPTION: " ++ descr,
-          "",
-          "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 SOCKEYE: DO NOT EDIT!" ]
-
-
-fact_argdecl :: String -> FactAttribute -> [C.Param]
-fact_argdecl sn (FAttrib tr (Name n) desc) = 
-    [ C.Param (type_c_type sn tr) n ]
-
-fact_attrib_decl :: String -> FactAttribute -> [C.Param]
-fact_attrib_decl sn (FAttrib tr (Name n) desc) = 
-    [ C.ParamComment desc,
-      C.Param (type_c_type sn tr) n ]
-
---msg_argdecl RX sn (Arg tr (DynamicArray n l)) = 
---    [ C.Param (C.Ptr $ type_c_type_dir RX sn tr) n, 
---      C.Param (type_c_type_dir RX sn size) l ]
---msg_argdecl TX sn (Arg tr (DynamicArray n l)) = 
---    [ C.Param (C.Ptr $ C.ConstT $ type_c_type_dir TX sn tr) n, 
---      C.Param (type_c_type_dir TX sn size) l ]
-
-
-query_argdecl :: String -> QueryParam -> [C.Param]
-query_argdecl sn (QParam (Name n) desc) = 
-    [  ]
-
-
--- misc common bits of C
-localvar = C.VarDecl C.NoScope C.NonConst
-errvar = C.Variable "err"    
\ No newline at end of file
diff --git a/tools/sockeye/CAbsSyntax.hs b/tools/sockeye/CAbsSyntax.hs
deleted file mode 100644 (file)
index 5caedd1..0000000
+++ /dev/null
@@ -1,455 +0,0 @@
-{- 
-   CAbsSyntax: combinators for generating C99 syntax
-   
-  Part of Mackerel: a strawman device definition DSL for Barrelfish
-   
-  Copyright (c) 2009, 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, Haldeneggsteig 4, CH-8092 Zurich. Attn: Systems Group.
--}  
-
-module CAbsSyntax where
-
-import Text.Printf
-import Data.Char
-import Data.List
-
---
--- Just enough syntax to generate files for Mackerel, etc.
---
-
-
-tabstop = "    " -- How much to indent
-
-indent_stmts :: [ Stmt ] -> [ String ] 
-indent_stmts sl = [ tabstop ++ l | l <- concat [ pp_stmt s | s <- sl ] ]
-
--- 
--- We start with expressions
---
-data Expr = NumConstant Integer         -- 123
-          | HexConstant Integer         -- 0xFF
-          | StringConstant String       -- "Hello!"
-          | StringCat [ StrElem ]       -- "Value is " PRIu64 " bytes"
-          | CharConstant Char           -- 'c'
-          | Variable String             -- index
-          | AddressOf Expr              -- &foo
-          | DerefPtr Expr               -- *foo
-          | DerefField Expr String      -- (foo)->string
-          | Assignment Expr Expr        -- foo = bar
-          | Unary UnOp Expr             -- -(foo)
-          | Binary BinOp Expr Expr      -- (a) + (b)
-          | Ternary Expr Expr Expr      -- p ? a : b
-          | FieldOf Expr String         -- p.field
-          | SubscriptOf Expr Expr       -- p[q]
-          | Call String [ Expr ]        -- fn(a,b,c)
-          | CallInd Expr [ Expr ]       -- (fn)(a,b,c)
-          | SizeOf Expr                 -- sizeof(expr)
-          | SizeOfT TypeSpec            -- sizeof(int)
-          | Cast TypeSpec Expr          -- (foo_t)(expr)
-          | PostInc Expr                -- (foo)++
-          | PostDec Expr                -- (foo)--
-          | PreInc Expr                 -- ++(foo)
-          | PreDec Expr                 -- --(foo)
-          | Parens Expr                 -- (e)
-          | StructConstant String [(String, Expr)] -- (struct foo){ .field = val, }
-          | ArrayConstant [Expr]        -- { val, }
-            deriving (Show, Eq)
-
-pp_expr :: Expr -> String
-pp_expr (NumConstant i) = printf "%d" i
-pp_expr (HexConstant i) = printf "0x%x" i
-pp_expr (StringConstant s) = "\"" ++ (concat $ map (\x -> showLitChar x "") s) ++ "\""
-pp_expr (StringCat l) = concat $ intersperse " " $ map pp_strelem l
-pp_expr (CharConstant c) = "'" ++ showLitChar c "'"
-pp_expr (Variable s) = s
-pp_expr (AddressOf e) = "&" ++ (pp_par_expr e)
-pp_expr (DerefPtr e) = "*" ++ (pp_par_expr e)
-pp_expr (DerefField e s) = (pp_par_expr e) ++ "->" ++ s
-pp_expr (Assignment e1 e2) = (pp_expr e1) ++ " = " ++ (pp_par_expr e2)
-pp_expr (Unary o e) = (pp_unop o) ++ (pp_par_expr e)
-pp_expr (Binary o e1 e2) 
-    = (pp_par_expr e1) ++" " ++ (pp_binop o) ++ " "++(pp_par_expr e2)
-pp_expr (Ternary e1 e2 e3) 
-    = (pp_par_expr e1) ++ " ? " ++ (pp_par_expr e2) ++ " : " ++ (pp_par_expr e3)
-pp_expr (FieldOf e s) = (pp_par_expr e) ++ "." ++ s
-pp_expr (SubscriptOf e1 e2) = (pp_par_expr e1) ++ "[" ++ (pp_expr e2) ++ "]"
-pp_expr (Call f al) 
-    = f ++ "(" ++ (concat $ intersperse ", " [ pp_expr e | e <- al ]) ++ ")"
-pp_expr (CallInd f al) 
-    = "(" ++ (pp_expr f) ++ ")(" ++ (concat $ intersperse ", " [ pp_expr e | e <- al ]) ++ ")"
-pp_expr (SizeOf e) = "sizeof(" ++ (pp_expr e) ++ ")"
-pp_expr (SizeOfT t) = "sizeof(" ++ (pp_typespec t "") ++ ")"
-pp_expr (Cast s e) = "(" ++ (pp_typespec s "") ++ ")(" ++ (pp_expr e) ++ ")"
-pp_expr (PostInc e) = (pp_par_expr e) ++ "++"
-pp_expr (PostDec e) = (pp_par_expr e) ++ "--"
-pp_expr (PreInc e) = "++" ++ (pp_par_expr e)
-pp_expr (PreDec e) = "--" ++ (pp_par_expr e)
-pp_expr (Parens e) = "(" ++ (pp_expr e) ++ ")"
-pp_expr (StructConstant n il) = "(struct " ++ n ++ "){ " ++ inits ++ " }"
-  where inits = concat $ intersperse ", " [ " ." ++ f ++ " = " ++ pp_expr v | (f,v) <- il ]
-pp_expr (ArrayConstant vl) = "{ " ++ (concat $ intersperse ", " (map pp_expr vl)) ++ " }"
-
-pp_par_expr :: Expr -> String
-pp_par_expr (Variable s) = s
-pp_par_expr e@(NumConstant _) = pp_expr e
-pp_par_expr e@(HexConstant _) = pp_expr e
-pp_par_expr c@(Call _ _) = pp_expr c
-pp_par_expr e = "(" ++ (pp_expr e) ++ ")"
-
-data StrElem = QStr String
-             | NStr String
-               deriving (Show, Eq)
-
-pp_strelem :: StrElem -> String
-pp_strelem (QStr s) = pp_expr (StringConstant s)
-pp_strelem (NStr s) = s
-
---
--- Binary operators
---
-data BinOp = Plus 
-           | Minus 
-           | Times 
-           | Divide 
-           | Modulo 
-           | Equals
-           | NotEquals
-           | GreaterThan
-           | LessThan 
-           | GreaterThanEq
-           | LessThanEq
-           | BitwiseAnd
-           | BitwiseOr
-           | BitwiseXor
-           | And
-           | Or 
-           | LeftShift
-           | RightShift
-             deriving (Show, Eq)
-
-pp_binop :: BinOp -> String
-pp_binop Plus = "+"
-pp_binop Minus = "-"
-pp_binop Times = "*"
-pp_binop Divide = "/"
-pp_binop Modulo = "%"
-pp_binop Equals= "=="
-pp_binop NotEquals= "!="
-pp_binop GreaterThan= ">"
-pp_binop LessThan = "<"
-pp_binop GreaterThanEq= ">="
-pp_binop LessThanEq= "<="
-pp_binop BitwiseAnd= "&"
-pp_binop BitwiseOr= "|"
-pp_binop BitwiseXor= "^"
-pp_binop And= "&&"
-pp_binop Or = "||"
-pp_binop LeftShift= "<<"
-pp_binop RightShift= ">>"
-
---
--- Unary operators
---
-data UnOp = Not | Negate | BitwiseNot 
-             deriving (Show, Eq)
-
-pp_unop :: UnOp -> String
-pp_unop Not = "!"
-pp_unop Negate = "-"
-pp_unop BitwiseNot = "~"
-
---
--- Parameters to function definitions
---
-data Param = Param TypeSpec String
-           | ParamComment String
-           | ParamBlank
-             deriving (Show, Eq)
-
-pp_param :: Param -> String
-pp_param (Param t s) = (pp_typespec t s)
-pp_param (ParamComment s) = "/* " ++ s ++ " */"
-pp_param ParamBlank = ""
-
---
--- Members of an enumeration definition
---
-data EnumItem = EnumItem String (Maybe Expr)
-             deriving (Show, Eq)
-
-pp_enumitem :: EnumItem -> String
-pp_enumitem (EnumItem s (Just e)) = s ++ " = " ++( pp_expr e)
-pp_enumitem (EnumItem s Nothing) = s
-
-
---
--- Include directives
---
-data IncludePath = Standard | Local
-                   deriving (Show, Eq)
-pp_include :: IncludePath -> String -> String
-pp_include Standard f = printf "#include <%s>" f
-pp_include Local f = printf "#include \"%s\"" f
-
---
--- Scope of a function or variable
---
-data ScopeSpec = Extern | Static | NoScope
-                 deriving (Show, Eq)
-
-pp_scopespec :: ScopeSpec -> String
-pp_scopespec Extern = "extern "
-pp_scopespec Static = "static "
-pp_scopespec NoScope = ""
-
---
--- Constancy
---
-data ConstSpec = Const | NonConst
-                 deriving (Show, Eq)
-pp_constspec :: ConstSpec -> String
-pp_constspec Const = "const "
-pp_constspec NonConst = ""
-
---
--- A Unit is a chunk of source file, i.e. top-level syntactic constructs. 
---
--- Note that we treat static inlines as their own construct.  It's easier. 
---
-data Unit = Comment String
-          | DoxyComment String
-          | MultiComment [ String ]
-          | MultiDoxy [ String ]
-          | TypeDef TypeSpec String
-          | FunctionDef ScopeSpec TypeSpec String [ Param ] [ Stmt ]
-          | StaticInline TypeSpec String [ Param ] [ Stmt ]
-          | StructDecl String [ Param ]
-          | StructForwardDecl String
-          | StructDef ScopeSpec String String [ (String, String) ]
-          | UnionDecl String [ Param ]
-          | UnionForwardDecl String
-          | EnumDecl String [ EnumItem ]
-          | FunctionDecl ScopeSpec TypeSpec String [ Param ]
-          | GVarDecl ScopeSpec ConstSpec TypeSpec String (Maybe Expr)
-          | Define String [ String ] String
-          | Undef String
-          | IfDef String [ Unit ] [ Unit ]
-          | IfNDef String [ Unit ] [ Unit ]
-          | HashIf String [ Unit ] [ Unit ]
-          | UnitList [ Unit ]
-          | NoOp
-          | Blank
-          | Include IncludePath String
-             deriving (Show, Eq)
-
-pp_unit :: Unit -> [ String ] 
-pp_unit (Comment s) = [ "// " ++ s ]
-pp_unit (DoxyComment s) = [ "///< " ++ s ]
-pp_unit (MultiComment sl) = ["/*"] ++ [ " * " ++ s | s <- sl ] ++ [ " */"] 
-pp_unit (MultiDoxy sl) = ["/**"] ++ [ " * " ++ s | s <- sl ] ++ [ " */"] 
-pp_unit (TypeDef ts s) = [ "typedef " ++ (pp_typespec ts s) ++ ";" ]
-pp_unit (FunctionDef sc ts n pl body) =
-    [ (pp_scopespec sc) ++ " " ++ (pp_fnhead ts n pl) ] ++ (pp_fnbody body)
-pp_unit (StaticInline ts n pl body) = 
-    [ head ++ " __attribute__ ((always_inline));",
-      head ] ++ (pp_fnbody body)
-    where 
-      head = "static inline " ++ (pp_fnhead ts n pl)
-pp_unit (StructDecl s pl) = 
-    [ printf "struct %s {" s ] ++ pp_structunion_body pl ++ ["};"]
-pp_unit (StructForwardDecl s) = 
-    [ printf "struct %s;" s ]
-pp_unit (StructDef sc s n fl) =
-    [ (pp_scopespec sc) ++ " " ++ (printf "struct %s %s = {" s n)]
-    ++ [ tabstop ++ (pp_fieldinit f) | f <- fl ] ++ ["};"]
-    where
-        pp_fieldinit (n,v) = printf ".%s = %s," n v
-pp_unit (UnionDecl s pl) = 
-    [ printf "union %s {" s ] ++ [ tabstop ++ (pp_param p) ++ ";" 
-                                        | p <- pl ] ++ ["};"]
-pp_unit (UnionForwardDecl s) = 
-    [ printf "union %s;" s ]
-pp_unit (EnumDecl s el) = 
-    [ printf "typedef enum %s {" s ] 
-    ++ 
-    (comma_sep_lines [ tabstop ++ (pp_enumitem e) | e <- el ])
-    ++ 
-    [ printf "} %s;" s]
-pp_unit (FunctionDecl sc ts n pl) = 
-    [ (pp_scopespec sc) ++ " " ++ (pp_fnhead ts n pl) ++ ";" ] 
-pp_unit (GVarDecl sc cs ts s Nothing) = 
-    [ printf "%s%s%s;" (pp_scopespec sc) (pp_constspec cs) (pp_typespec ts s)]
-pp_unit (GVarDecl sc cs ts s (Just e)) = 
-    [ printf "%s%s%s = %s;" 
-                 (pp_scopespec sc) 
-                 (pp_constspec cs) 
-                 (pp_typespec ts s) 
-                 (pp_expr e) ]
-pp_unit (Define n [] v) = [ printf "#define %s %s"  n v ]
-pp_unit (Define n al v) 
-    = [ printf "#define %s(%s) %s" n (concat $ intersperse "," al) v ]
-pp_unit (Undef s) = [ "#undef " ++ s ]
-pp_unit (IfDef s l r) = pp_cppcond "ifdef" s l r 
-pp_unit (IfNDef s l r) = pp_cppcond "ifndef" s l r 
-pp_unit (HashIf s l r) = pp_cppcond "if" s l r 
-pp_unit (UnitList l) = concat $ map pp_unit l 
-pp_unit NoOp = []
-pp_unit Blank = [""]
-pp_unit (Include s p) = [ pp_include s p ]
-
-pp_structunion_body :: [Param] -> [String]
-pp_structunion_body pl = [ tabstop ++ (pp_param p) ++ opt_trailer p | p <- pl ]
-  where
-    opt_trailer (Param _ _) = ";"
-    opt_trailer _ = ""
-
-comma_sep_lines :: [String] -> [String] 
-comma_sep_lines [] = []
-comma_sep_lines [s] = [s]
-comma_sep_lines (s:sl) = (s ++ ","):(comma_sep_lines sl)
-
-pp_cppcond :: String -> String -> [ Unit ] -> [ Unit ] -> [ String ]
-pp_cppcond t e l r = 
-    [ "#" ++ t ++ " " ++ e ] 
-    ++ 
-    (concat [ pp_unit u | u <- l ])
-    ++ 
-    (if r == [] then [] else "#else":concat [ pp_unit u | u <- r ])
-    ++ 
-    [ "#endif // " ++ e ]
-
-pp_cppcond_stmt :: String -> String -> [ Stmt ] -> [ Stmt ] -> [ String ]
-pp_cppcond_stmt t e l r = 
-    [ "#" ++ t ++ " " ++ e ] 
-    ++ 
-    (concat [ pp_stmt u | u <- l ])
-    ++ 
-    (if r == [] then [] else "#else":concat [ pp_stmt u | u <- r ])
-    ++ 
-    [ "#endif // " ++ e ]
-
-
-pp_fnbody :: [ Stmt ] -> [ String ] 
-pp_fnbody body = [ "{" ] ++ (indent_stmts body) ++ [ "}", ""]
-
-pp_fnhead :: TypeSpec -> String -> [ Param ] -> String
-pp_fnhead ts n pl = 
-    (pp_typespec ts n) ++ "(" ++ parlist ++ ")" 
-    where 
-      parlist = concat $ intersperse ", " [ pp_param p | p <- pl ]
-
--- 
--- Branches of a case statement: note that they fall through
---
-data Case = Case Expr [ Stmt ]
-            deriving (Show, Eq)
-                   
-pp_case :: Case -> [ String ]
-pp_case (Case e s) 
-    = [ "case " ++ (pp_expr e) ++ ":" ] ++ (indent_stmts s)
-
---
--- Statements.
---
-data Stmt = Return Expr 
-          | ReturnVoid
-          | Block [ Stmt ]
-          | StmtList [ Stmt ]
-          | Ex Expr
-          | If Expr [ Stmt ] [ Stmt ]
-          | DoWhile  Expr [ Stmt ]
-          | While Expr [ Stmt ] 
-          | For Expr Expr Expr [ Stmt ]
-          | Switch Expr [ Case ] [ Stmt ]  -- last list is default clause
-          | Break
-          | Continue
-          | Label String
-          | Goto String
-          | VarDecl ScopeSpec ConstSpec TypeSpec String (Maybe Expr)
-          | SComment String
-          | SBlank
-          | SIfDef String [ Stmt ] [ Stmt ] -- XXX: for #ifdef in the middle of a function
-            deriving (Show, Eq)
-
-pp_stmt :: Stmt -> [ String ]
-pp_stmt (Return e) = [ "return(" ++ (pp_expr e) ++ ");" ]
-pp_stmt ReturnVoid = [ "return;" ]
-pp_stmt (Block sl) = [ "{" ] ++ (indent_stmts sl) ++ ["}"]
-pp_stmt (StmtList sl) = concat $ map pp_stmt sl
-pp_stmt (Ex e) = [ (pp_expr e) ++ ";" ]
-pp_stmt (If e sl []) = 
-    [ "if (" ++ (pp_expr e) ++ ") {" ] ++ (indent_stmts sl) ++ ["}"]
-pp_stmt (If e sl1 sl2) 
-    = [ "if (" ++ (pp_expr e) ++ ") {" ] 
-      ++ (indent_stmts sl1) 
-      ++ ["} else {"] 
-      ++ (indent_stmts sl2) ++ [ "}"]
-pp_stmt (DoWhile e sl) 
-    = [ "do {" ] ++ (indent_stmts sl) ++ [ "} while (" ++ (pp_expr e) ++ ");" ]
-pp_stmt (While e sl) 
-    = [ "while (" ++ (pp_expr e) ++ ") {" ] 
-      ++ (indent_stmts sl) ++ ["}"]
-pp_stmt (For e1 e2 e3 sl) 
-    = ( [ "for( " ++ (pp_expr e1) ++ "; " 
-          ++  (pp_expr e2) ++ "; " 
-          ++ (pp_expr e3) ++ ") {" 
-        ]
-        ++ (indent_stmts sl) 
-        ++ ["}"]
-      )
-pp_stmt (Switch e cl sl) 
-    = ( [ "switch (" ++ (pp_expr e) ++ ") {" ] 
-        ++ concat [ pp_case c | c <- cl ] 
-        ++ [ "default:" ] 
-        ++ (indent_stmts sl)
-        ++ [ "}" ]
-      )
-pp_stmt Break = [ "break;" ]
-pp_stmt Continue = [ "continue;" ]
-pp_stmt (Label s) = [ s ++ ":" ]
-pp_stmt (Goto s) = [ "goto " ++ s ++ ";" ]
-pp_stmt (VarDecl sc cs ts s Nothing) = 
-    [ printf "%s%s%s;" (pp_scopespec sc) (pp_constspec cs) (pp_typespec ts s)]
-pp_stmt (VarDecl sc cs ts s (Just e)) = 
-    [ printf "%s%s%s = %s;" 
-                 (pp_scopespec sc) 
-                 (pp_constspec cs) 
-                 (pp_typespec ts s) 
-                 (pp_expr e) ]
-pp_stmt (SComment s) = [ "// " ++ s ]
-pp_stmt SBlank = [ "" ]
-pp_stmt (SIfDef s l r) = pp_cppcond_stmt "ifdef" s l r 
-
---
--- Type specifiers
---
-data TypeSpec = Void
-              | Struct String
-              | Union String
-              | Enum String 
-              | Ptr TypeSpec
-              | Array Integer TypeSpec
-              | TypeName String
-              | Function ScopeSpec TypeSpec [ Param ]
-              -- XXX: hacky way to get qualifiers on a type spec
-              | ConstT TypeSpec
-              | Volatile TypeSpec
-                deriving (Show, Eq)
-
-pp_typespec :: TypeSpec -> String -> String
-pp_typespec Void n = "void " ++ n
-pp_typespec (Struct s) n = printf "struct %s %s" s n
-pp_typespec (Union s) n = printf "union %s %s" s n
-pp_typespec (Enum s) n = printf "enum %s %s" s n
-pp_typespec (Ptr t) n = pp_typespec t ("*" ++n)
-pp_typespec (Array 0 t) n = pp_typespec t (n++"[]")
-pp_typespec (Array i t) n = pp_typespec t $ printf "%s[%d]" n i
-pp_typespec (TypeName s) n = printf "%s %s" s n
-pp_typespec (Function sc ts pl) n 
-    = (pp_scopespec sc) ++ " " ++ (pp_fnhead ts n pl)
-pp_typespec (ConstT t) n = "const " ++ pp_typespec t n
-pp_typespec (Volatile t) n = "volatile " ++ pp_typespec t n
diff --git a/tools/sockeye/CSyntax.hs b/tools/sockeye/CSyntax.hs
deleted file mode 100644 (file)
index 74dccc1..0000000
+++ /dev/null
@@ -1,161 +0,0 @@
-{- 
-   CSyntax: functions for rendering C syntactic structures.  
-   
-  Part of Mackerel: a strawman device definition DSL for Barrelfish
-   
-  Copyright (c) 2007, 2008, 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, Haldeneggsteig 4, CH-8092 Zurich. Attn: Systems Group.
--}  
-
-module CSyntax where
-
-import Data.List
-import Text.Printf
-
-infixr 9 >:
-(>:) :: String -> [String] -> [String]
-s >: [] = [s]
-s >: (x:xs) = (s ++ " " ++ x) : xs
-
-infixr 9 <:
-(<:) :: [String] -> String -> [String]
-[] <: s = [s]
-(h:t) <: s = let (x:xs) = reverse (h:t) in
-             reverse ((x ++ " " ++ s):xs )
-
-header_file :: String -> String -> String
-header_file name body = 
-    let sym = "__" ++ name ++ "_H" 
-    in unlines [ "#ifndef " ++ sym,
-                 "#define " ++ sym,
-                 "",
-                 body,
-                 "",
-                 "#endif // " ++ sym
-                 ]
-
-undef :: String -> String
-undef n = "#undef " ++ n
-
-include :: String -> String
-include f = "#include <" ++ f ++ ".h>"
-
-include_local :: String -> String
-include_local f = "#include \"" ++ f ++ ".h\""
-
-block :: [String] -> [String]
-block lines = 
-    ["{"] ++ (indent lines) ++ ["}"]
-
-typedef :: String -> String -> String
-typedef name typestr = "typedef " ++ typestr ++ " " ++ name ++ ";" 
-
-constint :: String -> Integer -> String
-constint name val = printf "static const int %s = 0x%0x;" name val
-
-struct :: String -> [ String ] -> [ String ]
-struct name fields =  structunion "struct" name fields 
-
-struct_field n v = printf "%s\t%s;" n v
-
-union :: String -> [ String ] -> [ String ]
-union name fields =  structunion "union" name fields
-
-union_field n v = struct_field n v
-
-structunion :: String -> String -> [ String ] -> [ String ]
-structunion su name fields = 
-    (su ++ " " ++ name) >: (block fields) 
-
-bitfields name fields = 
-    ("struct " ++ name) >: (block fields) <: "__attribute__ ((packed))" 
-
-bitfield n w t = printf "%s\t%s\t:%d;" t n w 
-
-
-enum :: String -> [ (String, String) ] -> String
-enum name vals = 
-    let tname = name -- ++ "_t"   
-    in
-      unlines ( ((printf "typedef enum %s" tname) 
-                >: block [ printf "%s = %s," n v | (n, v) <- vals] )
-                <: (printf "%s;" tname) )
-
-enum_anon :: String -> [ (String, String) ] -> [String]
-enum_anon tag vals = ("enum " ++ tag) >: block [ printf "%s = %s," n v | (n, v) <- vals] 
-
-
-function_proto :: String -> String -> String -> [(String,String)] -> String 
-function_proto attr rtype name args = 
-    printf "%s %s %s( %s )" attr rtype name (func_args args)
-
-function1 :: String -> String -> String -> [(String,String)] -> [String] -> [String ]
-function1 attr rtype name args body 
-    = (function_proto attr rtype name args ):(block body)
-static :: String -> String -> [(String,String)] -> [String] -> [ String ]
-static rtype name args body = function1 "static" rtype name args body
-inline :: String -> String -> [(String,String)] -> [String] -> [String]
-inline rtype name args body =
-    function1 "static inline" rtype name args body
-
-             
-func_args:: [(String,String)] -> String
-func_args alist = 
-    concat (intersperse ", " [ (n ++ " " ++ v) | (n,v) <- alist ])
-
-multi_comment1 str = [ "", "/*" ] ++ [" * " ++ l | l <- lines str] ++ [ " */"]
-
-comment s = "// " ++ s
-
-indent :: [String] -> [String]
-indent l = [ "    " ++ line | line <- l ]
-
-switch :: String -> [ (String, String) ] -> String -> [String]
-switch disc alts dflt = 
-    (printf "switch (%s)" disc) 
-    >: block ( concat [ [ printf "case %s:" a, printf "%s" l ]
-                            | (a,l) <- alts ]
-               ++ [ "default:", printf "%s" dflt ] )
-
-switch1 :: String -> [ (String,[String]) ] -> [String] -> [String]
-switch1 disc alts dflt = 
-    (printf "switch (%s)" disc) 
-    >: (block (concat [ (printf "case %s:" a):l | (a,l) <- alts ] ++ ("default:"):dflt ))
-
-if_stmt :: String -> [String] -> [String]
-if_stmt cond thenclause = 
-    (printf "if (%s) " cond):block thenclause
-
-if_else :: String -> [String] -> [String] -> [String]
-if_else cond thenclause elseclause = 
-    (if_stmt cond thenclause) ++ ("else":(block elseclause))
-
-forloop :: String -> String -> String -> [String] -> [String]
-forloop init iter term body = 
-    (printf "for( %s; %s; %s )" init iter term)
-    >: block body
-
---
--- Accumulating strings to print: much of the debugging code we
--- generate consists of successive calls to snprintf.
---
-
-snprintf :: String -> [ String ]
-snprintf s = snlike "snprintf" s
-
-snlike fn arg = [ "_avail = (r > sz) ? 0 : sz-r;",
-                  printf "_rc = %s(s+r, _avail, %s);" fn arg,
-                  "if ( _rc > 0 && _rc < _avail) { r += _rc; }"
-                ]
-                  
-snputs :: String -> [ String ]
-snputs s = snprintf (printf "\"%%s\", %s" s)
-
-snputsq :: String -> [ String ]
-snputsq s = snprintf (printf "\"%%s\", \"%s\"" s)
diff --git a/tools/sockeye/Hakefile b/tools/sockeye/Hakefile
deleted file mode 100644 (file)
index 939cbdc..0000000
+++ /dev/null
@@ -1,14 +0,0 @@
-----------------------------------------------------------------------
--- Copyright (c) 2015, 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, Universitaetsstrasse 6, CH-8092 Zurich. 
--- Attn: Systems Group.
---
--- Hakefile for /tools/sockeye
---
-----------------------------------------------------------------------
-
-[ compileHaskell "sockeye" "Main.lhs" (find withSuffices [".hs",".lhs"]) ]
diff --git a/tools/sockeye/MachineModel.xsd b/tools/sockeye/MachineModel.xsd
deleted file mode 100644 (file)
index 4035561..0000000
+++ /dev/null
@@ -1,58 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<xs:schema targetNamespace="http://www.barrelfish.org/MachineModel/core"
-    elementFormDefault="qualified" id="core" xmlns:xs="http://www.w3.org/2001/XMLSchema"
-    xmlns:mc="http://www.barrelfish.org/MachineModel/core">
-
-    <xs:simpleType name="PCI_ID">
-        <xs:restriction base="xs:int">
-            <xs:minInclusive value="0"></xs:minInclusive>
-            <xs:maxInclusive value="255"></xs:maxInclusive>
-        </xs:restriction>
-    </xs:simpleType>
-
-    <xs:simpleType name="paddr">
-        <xs:annotation>
-            <xs:documentation>
-                Physical memory address.
-            </xs:documentation>
-        </xs:annotation>
-        <xs:restriction base="xs:int">
-            <xs:minInclusive value="0"></xs:minInclusive>
-        </xs:restriction>
-    </xs:simpleType>
-
-    <xs:complexType name="addr">
-        <xs:annotation>
-            <xs:documentation>A PCI (bus, device, function) triple.
-            </xs:documentation>
-        </xs:annotation>
-        <xs:attribute type="mc:PCI_ID" name="bus">
-            <xs:annotation>
-                <xs:documentation>The bus number of a PCI address.</xs:documentation>
-            </xs:annotation>
-        </xs:attribute>
-        <xs:attribute type="mc:PCI_ID" name="device">
-            <xs:annotation>
-                <xs:documentation>The device number of a PCI address.</xs:documentation>
-            </xs:annotation>
-        </xs:attribute>
-        <xs:attribute type="mc:PCI_ID" name="function">
-            <xs:annotation>
-                <xs:documentation>The function number of a PCI address.</xs:documentation>
-            </xs:annotation>
-        </xs:attribute>
-    </xs:complexType>
-
-    <xs:complexType name="mem">
-        <xs:attribute type="mc:paddr" name="start"></xs:attribute>
-        <xs:attribute type="mc:paddr" name="end"></xs:attribute>
-    </xs:complexType>
-
-    <xs:complexType name="rootbus">
-        <xs:sequence>
-            <xs:element type="mc:addr" name="addr"></xs:element>
-            <xs:element type="mc:mem" name="mem"></xs:element>
-        </xs:sequence>
-    </xs:complexType>
-
-</xs:schema>
\ No newline at end of file
diff --git a/tools/sockeye/MachineModelCode.xsl b/tools/sockeye/MachineModelCode.xsl
deleted file mode 100644 (file)
index de34096..0000000
+++ /dev/null
@@ -1,185 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<xsl:stylesheet version="1.0"
-    xmlns:xsl="http://www.w3.org/1999/XSL/Transform" xmlns:xs="http://www.w3.org/2001/XMLSchema">
-    <xsl:output method="text" indent="no" />
-
-    <xsl:strip-space elements="xs:sequence"/>
-
-    <!-- Generate a name from an element -->
-    <xsl:template name="gen-name">
-        <xsl:param name="element"></xsl:param>
-        <xsl:value-of select="/xs:schema/@id" />_<xsl:value-of select="$element/@name" />
-    </xsl:template>
-
-    <!-- Convert a type name to a name without namespace -->
-    <xsl:template name="GetRefName">
-        <xsl:param name="ref" />
-        <xsl:choose>
-            <xsl:when test="contains($ref, ':')">
-                <!-- Ref has namespace prefix -->
-                <xsl:value-of select="substring-after($ref, ':')" />
-            </xsl:when>
-            <xsl:otherwise>
-                <!-- Ref has no namespace prefix -->
-                <xsl:value-of select="$ref" />
-            </xsl:otherwise>
-        </xsl:choose>
-    </xsl:template>
-
-    <!-- Generate the C type from a xs:restriction -->
-    <xsl:template name="gen-type">
-        <xsl:param name="restriction" />
-        <xsl:choose>
-            <xsl:when test="$restriction/@base='xs:int'">
-                <xsl:choose>
-                    <xsl:when test="$restriction/xs:minInclusive/@value = 0">
-                        <xsl:choose>
-                            <xsl:when test="$restriction/xs:maxInclusive/@value &lt; 256">
-                                <xsl:text>uint8</xsl:text>
-                            </xsl:when>
-                            <xsl:when test="$restriction/xs:maxInclusive/@value &lt; 65536">
-                                <xsl:text>uint16</xsl:text>
-                            </xsl:when>
-                            <xsl:when test="$restriction/xs:maxInclusive/@value &lt; 4294967296">
-                                <xsl:text>uint32</xsl:text>
-                            </xsl:when>
-                            <xsl:otherwise>
-                                <xsl:text>uint64</xsl:text>
-                            </xsl:otherwise>
-                        </xsl:choose>
-                    </xsl:when>
-                    <xsl:otherwise>
-                        <xsl:choose>
-                            <xsl:when test="$restriction/xs:maxInclusive/@value &lt; 127">
-                                <xsl:text>int8</xsl:text>
-                            </xsl:when>
-                            <xsl:when test="$restriction/xs:maxInclusive/@value &lt; 32768">
-                                <xsl:text>int16</xsl:text>
-                            </xsl:when>
-                            <xsl:when test="$restriction/xs:maxInclusive/@value &lt; 2147483648">
-                                <xsl:text>int32</xsl:text>
-                            </xsl:when>
-                            <xsl:otherwise>
-                                <xsl:text>int64</xsl:text>
-                            </xsl:otherwise>
-                        </xsl:choose>
-                    </xsl:otherwise>
-                </xsl:choose>
-            </xsl:when>
-            <xsl:otherwise>
-                <xsl:message terminate="yes">
-                    Unknown type: <xsl:value-of select="$restriction" />
-                </xsl:message>
-            </xsl:otherwise>
-        </xsl:choose>
-    </xsl:template>
-
-    <!-- Start of processing -->
-    <xsl:template match="/xs:schema">
-        <xsl:text>
-<![CDATA[
-/* Generated C code */
-#include <barrelfish/barrelfish.h>
-]]></xsl:text>
-        <xsl:apply-templates select="xs:annotation"></xsl:apply-templates>
-        <xsl:for-each select="xs:simpleType">
-            <xsl:call-template name="typedef-type"></xsl:call-template>
-        </xsl:for-each>
-        <xsl:for-each select="xs:complexType">
-            <xsl:call-template name="complex-struct"></xsl:call-template>
-        </xsl:for-each>
-        <xsl:text>&#10;</xsl:text>
-        <xsl:for-each select="xs:complexType">
-            <xsl:call-template name="gen-function-header">
-                <xsl:with-param name="type" select="current()" />
-            </xsl:call-template>
-        </xsl:for-each>
-    </xsl:template>
-
-    <xsl:template match="xs:simpleType" name="typedef-type">
-        <xsl:apply-templates select="xs:annotation"></xsl:apply-templates>
-        <xsl:variable name="type">
-            <xsl:call-template name="gen-type">
-                <xsl:with-param name="restriction" select="xs:restriction"/>
-            </xsl:call-template>
-        </xsl:variable>
-        <xsl:text>&#10;typedef </xsl:text>
-        <xsl:value-of select="$type" />
-        <xsl:text> </xsl:text>
-        <xsl:value-of select="@name" />
-        <xsl:text>;</xsl:text>
-    </xsl:template>
-
-    <xsl:template match="xs:complexType" name="complex-struct">
-        <xsl:apply-templates select="xs:annotation"></xsl:apply-templates>
-        <xsl:variable name="name">
-            <xsl:call-template name="gen-name">
-                <xsl:with-param name="element" select="." />
-            </xsl:call-template>
-        </xsl:variable>
-        <xsl:text>&#10;&#10;struct </xsl:text>
-        <xsl:value-of select="$name" /><xsl:text> {</xsl:text>
-        <xsl:apply-templates select="xs:sequence|xs:attribute"></xsl:apply-templates>
-        <xsl:text>&#10;};</xsl:text>
-    </xsl:template>
-
-    <xsl:template match="xs:sequence">
-        <xsl:apply-templates select="xs:element"/>
-    </xsl:template>
-
-    <xsl:template match="xs:element">
-        <xsl:apply-templates select="xs:annotation"></xsl:apply-templates>
-        <xsl:variable name="typeName">
-            <xsl:call-template name="GetRefName">
-                <xsl:with-param name="ref" select="@type"/>
-            </xsl:call-template>
-        </xsl:variable>
-
-        <xsl:text>&#10;    struct </xsl:text>
-        <xsl:call-template name="gen-name">
-            <xsl:with-param name="element" select="/xs:schema/xs:complexType[@name = $typeName]">
-            </xsl:with-param>
-        </xsl:call-template>
-        <xsl:text> </xsl:text>
-        <xsl:value-of select="@name" />
-        <xsl:text>;</xsl:text>
-    </xsl:template>
-
-    <xsl:template match="xs:attribute">
-        <xsl:variable name="typeName">
-            <xsl:call-template name="GetRefName">
-                <xsl:with-param name="ref" select="@type"/>
-            </xsl:call-template>
-        </xsl:variable>
-        <xsl:apply-templates select="xs:annotation"></xsl:apply-templates>
-        <xsl:text>&#10;    </xsl:text>
-        <xsl:value-of select="$typeName"></xsl:value-of>
-        <xsl:text> </xsl:text>
-        <xsl:value-of select="@name"></xsl:value-of>
-        <xsl:text>;</xsl:text>
-    </xsl:template>
-
-    <xsl:template name="gen-function-header">
-        <xsl:param name="type" />
-        <xsl:text>&#10;errval_t </xsl:text>
-
-        <xsl:variable name="name">
-            <xsl:call-template name="gen-name">
-                <xsl:with-param name="element" select="$type" />
-            </xsl:call-template>
-        </xsl:variable>
-
-        <xsl:value-of select="$name" />
-        <xsl:text>_add(struct </xsl:text>
-        <xsl:value-of select="$name" />
-        <xsl:text>*);</xsl:text>
-    </xsl:template>
-
-    <xsl:template match="xs:annotation">
-/**
-<xsl:for-each select="tokenize(current()/xs:documentation, '\r?\n')">
- * <xsl:sequence select="."/>
-</xsl:for-each> 
- */
-    </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
diff --git a/tools/sockeye/Main.lhs b/tools/sockeye/Main.lhs
deleted file mode 100644 (file)
index 2f2a8a1..0000000
+++ /dev/null
@@ -1,114 +0,0 @@
-%include polycode.fmt
-
-%if false
-  Flounder2: an even more simpler IDL for Barrelfish
-   
-  Copyright (c) 2009, 2010 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, Haldeneggsteig 4, CH-8092 Zurich. Attn: Systems Group.
-%endif
-
-
-
-> module Main where
-
-> import System.Environment
-> import System.Exit
-> import System.Console.GetOpt
-> import System.IO
-> import System.FilePath.Posix
-> import Data.Maybe
-> import Control.Monad
-
-> import Text.ParserCombinators.Parsec as Parsec
-> import qualified SockeyeParser
-> import qualified SockeyeSyntax
-> import qualified SockeyeCodeBackend
-> import qualified SockeyeHeaderBackend
-> import qualified SockeyeDocBackend
-> import qualified SockeyeTools
-
-
-> data Target = Header
->             | Code
->             | Documentation
->             deriving (Show)
-
-> data Options = Options {
->     optTargets :: [Target],
->     optIncludes :: [String]
-> }
-
-> defaultOptions :: Options
-> defaultOptions = Options { optTargets = [],  optIncludes = [] }
-
-> generator :: Options -> Target -> String -> String -> SockeyeSyntax.Schema -> String
-> generator _ Header = SockeyeHeaderBackend.compile
-> generator _ Code = SockeyeCodeBackend.compile
-> generator _ Documentation = SockeyeDocBackend.compile
->
->
-> addTarget :: Target -> Options -> IO Options
-> addTarget t o = return o { optTargets = (optTargets o) ++ [t] }
-
-
-
-> addInclude :: String -> Options -> IO Options
-> addInclude s o = return o { optIncludes = (optIncludes o) ++ [s] }
-
-> options :: [OptDescr (Options -> IO Options)]
-> options = [ 
->             Option ['H'] ["generic-header"] (NoArg $ addTarget Header) "Create a header file",
->             Option ['C'] ["generic-stub"] (NoArg $ addTarget Code) "Create code",
->             Option ['i'] ["import"] (ReqArg addInclude "FILE")      "Include a given file before processing", 
->             Option ['D'] ["documentation"] (NoArg $ addTarget Documentation)      "add documentation target"
->            ]
-
-
-
-> compile :: Options -> Target -> SockeyeSyntax.Schema -> String -> String -> Handle -> IO ()
-> compile opts fl ast infile outfile outfiled =
->     hPutStr outfiled $ (generator opts fl) infile outfile ast'
->   where
->       ast' = SockeyeTools.rewireTypes ast (SockeyeTools.collectTypes ast)
-
-> parseFile :: (String -> IO (Either Parsec.ParseError a)) -> String -> IO a
-> parseFile parsefn fname = do
->    input <- parsefn fname
->    case input of
->        Left err -> do
->            hPutStrLn stderr $ "Parse error at: " ++ (show err)
->            exitWith $ ExitFailure 1
->        Right x -> return x
-
-> parseIncludes :: Options -> IO [(String, SockeyeSyntax.Declaration)]
-> parseIncludes opts
->     = foldM (\d -> parseFile $ SockeyeParser.parse_include d) [] (optIncludes opts)
-
-> checkFilename :: SockeyeSyntax.Schema -> String -> IO ()
-> checkFilename schema fname = do
->                                 let SockeyeSyntax.Schema sname _ _ = schema
->                                 if sname == takeBaseName fname then return () else ioError $ userError ("Schema name name '" ++ sname ++ "' has to equal filename in " ++ fname)
-
-> main :: IO ()
-> main = do 
->        argv <- System.Environment.getArgs
->        case getOpt RequireOrder options argv of
->          (optf, [ inFile, outFile ], []) -> do
->              opts <- foldM (flip id) defaultOptions optf
->              includeDecls <- parseIncludes opts
->              ast <- parseFile (SockeyeParser.parse_intf includeDecls (takeBaseName inFile)) inFile
->              outFileD <- openFile outFile WriteMode
->              checkFilename ast inFile
->              sequence_ $ map (\target
->                               -> compile opts target ast inFile outFile outFileD)
->                            (optTargets opts)
->              hClose outFileD
->          (_, _, errors) -> do
->              hPutStr stderr (concat errors ++ usageInfo usage options)
->              exitWith (ExitFailure 1)
->       where
->           usage = "Usage: sockeye [OPTION...] input.fact output"
diff --git a/tools/sockeye/SockeyeCodeBackend.hs b/tools/sockeye/SockeyeCodeBackend.hs
deleted file mode 100644 (file)
index 4302d58..0000000
+++ /dev/null
@@ -1,609 +0,0 @@
-{- 
-   GCBackend: Flounder stub generator for generic code
-   
-  Part of Flounder: a message passing IDL for Barrelfish
-   
-  Copyright (c) 2007-2010, 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 SockeyeCodeBackend where
-
-import Data.Char
-
-
-
-import Data.List
-import Data.Char
-
-import qualified CAbsSyntax as C
-import SockeyeSyntax
-
-
-import qualified Backend
-import BackendCommon
-
-include_header_name n = "facts/" ++ ifscope n "schema.h"
-
-add_fn_name n = ifscope n "add" 
-
-
-------------------------------------------------------------------------
--- Language mapping: Create the generic header file for the interface
-------------------------------------------------------------------------
-
-compile :: String -> String -> Schema -> String
-compile infile outfile schema = 
-    unlines $ C.pp_unit $ sockeye_code_file infile schema
-
-
-sockeye_code_file :: String -> Schema -> C.Unit
-sockeye_code_file infile (Schema name descr decls) = 
-      let
-        (types, facts, queries) = Backend.partitionTypesFactsQueries decls
-        --messages = rpcs_to_msgs messagedecls
-    in
-      C.UnitList [
-      schema_preamble infile name descr,
-      C.Blank,
-
-      C.Include C.Standard "barrelfish/barrelfish.h",
-      C.Include C.Standard "flounder/flounder_support.h",
-      C.Include C.Standard ("schema/" ++ name ++ ".h"),
-      C.Blank,
-
-      C.MultiComment [ "Fact type signatures" ],
-      C.Blank,
-      C.UnitList [ fact_fn name f | f <- facts ],
-      C.Blank,
-
-      C.MultiComment [ "Query type signatures" ],
-      C.Blank,
-      C.UnitList [ query_fn name q | q <- queries ],
-      C.Blank
-    ]
-    
-  
-
---
--- Generate type definitions for each fact signature
---
-  
-fact_fn :: String -> FactDef -> C.Unit
-fact_fn sname f = C.UnitList [ 
-    C.MultiDoxy (["@brief  " ++ desc,
-                  ""] ++ param_desc),
-    C.FunctionDef C.NoScope (C.TypeName "errval_t") name params [
-      C.VarDecl C.NoScope C.NonConst (C.TypeName "errval_t") "err" Nothing,
-      C.SBlank,
-      C.Ex $ C.Assignment errvar (C.Call "skb_client_connect" []),
-      C.If (C.Call "err_is_fail" [errvar]) 
-        [C.Return $ errvar] [],
-      C.SBlank,
-      C.Ex $ C.Assignment errvar (C.Call "skb_add_fact" [C.Variable add_fact_string, (C.Call add_fact_args [C.Variable "arg"])]),
-      C.Return $ errvar
-    ],
-    C.Blank
-  ]
-  where 
-    name = fact_sig_type sname "add" f 
-    desc = fact_desc f 
-    params = [C.Param (C.Ptr $ C.Struct $ (fact_attrib_type sname f)) "arg"]
-    param_desc = [ fact_param_desc a | a <- fact_args f ]  
-    payload = case f of
-        Fact _ _ args -> [ fact_argdecl sname a | a <- args ]
-    add_fact_string = type_c_define sname (fact_name f) "FMT_READ"
-    add_fact_args = type_c_define sname (fact_name f) "FIELDS"
-
-
-
-query_fn :: String -> QueryDef -> C.Unit
-query_fn sname q = 
-  C.FunctionDecl C.NoScope (C.TypeName "errval_t") name params 
-  where 
-    name = query_sig_type sname q
-    params = concat payload
-    payload = case q of
-        Query _ _ args -> [ query_argdecl sname a | a <- args ]
-
-
-
-
-fact_attributes :: String -> FactDef -> C.Unit
-fact_attributes sname f = C.UnitList [ 
-    C.MultiDoxy (["Fact: " ++ name, 
-                  "@brief  " ++ desc]),
-    C.StructDecl name params,
-    C.TypeDef (C.Struct name) (name ++ "_t"),
-    C.Blank
-  ]
-  where 
-    name = fact_attrib_type sname f
-    desc = fact_desc f 
-    params = concat payload
-    payload = case f of
-        Fact _ _ args -> [ fact_attrib_decl sname a | a <- args ]
-
-
-
-
-{-
-
---
--- Generate a struct to hold the arguments of a message while it's being sent.
--- 
-msg_argstruct :: String -> [TypeDef] -> MessageDef -> C.Unit
-msg_argstruct ifname typedefs m@(RPC n args _) = 
-    C.StructDecl (msg_argstruct_name ifname n) 
-         (concat [ rpc_argdecl ifname a | a <- args ])
-msg_argstruct ifname typedefs m@(Message _ n [] _) = C.NoOp
-msg_argstruct ifname typedefs m@(Message _ n args _) =
-    let tn = msg_argstruct_name ifname n
-    in
-      C.StructDecl tn (concat [ msg_argstructdecl ifname typedefs a
-                               | a <- args ])
-
---
--- Generate a union of all the above
--- 
-intf_union :: String -> [MessageDef] -> C.Unit
-intf_union ifn msgs = 
-    C.UnionDecl (binding_arg_union_type ifn)
-         ([ C.Param (C.Struct $ msg_argstruct_name ifn n) n
-            | m@(Message _ n a _) <- msgs, 0 /= length a ]
-          ++
-          [ C.Param (C.Struct $ msg_argstruct_name ifn n) n
-            | m@(RPC n a _) <- msgs, 0 /= length a ]
-         )
-
---
--- Generate a struct defn for a vtable for the interface
---
-intf_vtbl :: String -> Direction -> [MessageDef] -> C.Unit
-intf_vtbl n d ml = 
-    C.StructDecl (intf_vtbl_type n d) [ intf_vtbl_param n m d | m <- ml ]
-
-intf_vtbl_param :: String -> MessageDef -> Direction ->  C.Param
-intf_vtbl_param ifn m d = C.Param (C.Ptr $ C.TypeName $ msg_sig_type ifn m d) (msg_name m)
-
---
------------------------------------------------------------------
--- Code to generate concrete type definitions
------------------------------------------------------------------
-
--}
-
-define_types :: String -> [TypeDef] -> [C.Unit]
-define_types schemaName types = 
-    [ define_type schemaName t | t <- types ]
-
-define_type :: String -> TypeDef -> C.Unit
-define_type sname (TAliasT newType originType) =
-    C.TypeDef (type_c_type sname $ Builtin originType) (type_c_name1 sname newType)
-
-{-
-This enumeration:
-\begin{verbatim}
-typedef enum {
-    foo, bar, baz
-} some_enum;
-\end{verbatim}
-
-Generates the following code:
-\begin{verbatim}
-enum ifname_some_enum_t {
-    ifname_some_enum_t_foo = 1,
-    ifname_some_enum_t_bar = 2,
-    ifname_some_enum_t_baz = 3,
-}
-\end{verbatim}
--}
-
-
-define_type sname (TEnum name elements) = 
-    C.EnumDecl (type_c_name1 sname name) 
-         [ C.EnumItem (type_c_enum sname e) Nothing | e <- elements ]
-
-
-   
-
-{-
-A typedef'd alias:
-\begin{verbatim}
-typedef uint32 alias_type;
-\end{verbatim}
-
-Should compile to:
-\begin{verbatim}
-typedef uint32_t ifname_alias_type_t;
-\end{verbatim}
--}
-
-define_type sname (TAlias newType originType) = 
-    C.TypeDef (type_c_type sname originType) (type_c_name1 sname newType)
-
-
-{-
-import GHBackend (flounder_backends, export_fn_name, bind_fn_name, accept_fn_name, connect_fn_name)
-import BackendCommon
-
-
-
-
--- name of the bind continuation function
-bind_cont_name :: String -> String
-bind_cont_name ifn = ifscope ifn "bind_continuation_direct"
-
--- name of an alternative bind continuation function
-bind_cont_name2 :: String -> String
-bind_cont_name2 ifn = ifscope ifn "bind_contination_multihop"
-
-
-
-compile :: String -> String -> Interface -> String
-compile infile outfile interface = 
-    unlines $ C.pp_unit $ stub_body infile interface
-
-stub_body :: String -> Interface -> C.Unit
-stub_body infile (Interface ifn descr _) = C.UnitList [
-    intf_preamble infile ifn descr,
-    C.Blank,
-
-    C.Include C.Standard "barrelfish/barrelfish.h",
-    C.Include C.Standard "flounder/flounder_support.h",
-    C.Include C.Standard ("if/" ++ ifn ++ "_defs.h"),
-    C.Blank,
-
-    C.MultiComment [ "Export function" ],
-    export_fn_def ifn,
-    C.Blank,
-
-    C.MultiComment [ "Functions to accept/connect over a already shared frame" ],
-    accept_fn_def ifn,
-    C.Blank,
-
-    C.MultiComment [ "Generic bind function" ],
-    -- the two bind functions use the idc drivers in a different order
-    bind_cont_def ifn (bind_cont_name ifn) (bind_backends ifn (bind_cont_name ifn)),
-    bind_cont_def ifn (bind_cont_name2 ifn) (multihop_bind_backends ifn (bind_cont_name2 ifn)),
-    bind_fn_def ifn,
-    connect_fn_def ifn]
-
-
-export_fn_def :: String -> C.Unit
-export_fn_def n = 
-    C.FunctionDef C.NoScope (C.TypeName "errval_t") (export_fn_name n) params [
-        localvar (C.Ptr $ C.Struct $ export_type n) "e"
-            (Just $ C.Call "malloc" [C.SizeOfT $ C.Struct $ export_type n]),
-        C.If (C.Binary C.Equals exportvar (C.Variable "NULL"))
-            [C.Return $ C.Variable "LIB_ERR_MALLOC_FAIL"] [],
-        C.SBlank,
-        C.SComment "fill in common parts of export struct",
-        C.StmtList [C.Ex $ C.Assignment dste (C.Variable srcn) | (dste, srcn) <- [
-                        (exportvar `C.DerefField` "connect_cb", "connect_cb"),
-                        (exportvar `C.DerefField` "waitset", "ws"),
-                        (exportvar `C.DerefField` "st", "st"),
-                        (commonvar `C.FieldOf` "export_callback", "export_cb"),
-                        (commonvar `C.FieldOf` "flags", "flags"),
-                        (commonvar `C.FieldOf` "connect_cb_st", "e"),
-                        (commonvar `C.FieldOf` "export_cb_st", "st")]],
-        C.SBlank,
-        C.SComment "fill in connect handler for each enabled backend",
-        C.StmtList [
-            C.SIfDef ("CONFIG_FLOUNDER_BACKEND_" ++ (map toUpper drv))
-             [C.Ex $ C.Assignment
-                        (commonvar `C.FieldOf` (drv_connect_callback drv))
-                        (C.Variable $ drv_connect_handler_name drv n)] []
-            | drv <- flounder_backends ],
-        C.SBlank,
-
-        C.Return $ C.Call "idc_export_service" [C.AddressOf commonvar]
-    ]
-    where 
-        params = [ C.Param (C.Ptr $ C.TypeName "void") "st",
-                   C.Param (C.Ptr $ C.TypeName "idc_export_callback_fn") "export_cb",
-                   C.Param (C.Ptr $ C.TypeName $ connect_callback_name n) "connect_cb",
-                   C.Param (C.Ptr $ C.Struct "waitset") "ws",
-                   C.Param (C.TypeName "idc_export_flags_t") "flags"]
-        exportvar = C.Variable "e"
-        commonvar = exportvar `C.DerefField` "common"
-
-        -- XXX: UMP_IPI uses the UMP connect callback
-        drv_connect_callback "ump_ipi" = drv_connect_callback "ump"
-        drv_connect_callback drv = drv ++ "_connect_callback"
-
-accept_fn_def :: String -> C.Unit
-accept_fn_def n = 
-    C.FunctionDef C.NoScope (C.TypeName "errval_t") (accept_fn_name n) params [
-        C.StmtList [
-        -- #ifdef CONFIG_FLOUNDER_BACKEND_UMP
-        C.SIfDef "CONFIG_FLOUNDER_BACKEND_UMP" [
-            C.Return $ C.Call (drv_accept_fn_name "ump" n)
-                [ C.Variable intf_frameinfo_var,
-                  C.Variable "st",
-                  C.Variable intf_cont_var,
-                  C.Variable "ws",
-                  C.Variable "flags"]
-             ]
-             -- #else
-            [ C.StmtList [
-                 C.Ex $ C.Call "assert" [
-                     C.Unary C.Not $ C.StringConstant "UMP backend not enabled!"
-                 ],
-                 C.Return $ C.Variable "ERR_NOTIMP"
-              ]
-            ]
-        ]
-    ]
-    where 
-        params = [ C.Param (C.Ptr $ C.Struct $ intf_frameinfo_type n) intf_frameinfo_var,
-                   C.Param (C.Ptr $ C.TypeName "void") "st",
-       --          C.Param (C.Ptr $ C.TypeName "idc_export_callback_fn") "export_cb",
-                   C.Param (C.Ptr $ C.TypeName $ intf_bind_cont_type n) intf_cont_var,
-                   C.Param (C.Ptr $ C.Struct "waitset") "ws",
-                   C.Param (C.TypeName "idc_export_flags_t") "flags"]
-
-
-connect_fn_def :: String -> C.Unit
-connect_fn_def n = 
-    C.FunctionDef C.NoScope (C.TypeName "errval_t") (connect_fn_name n) params [
-        C.StmtList [
-        -- #ifdef CONFIG_FLOUNDER_BACKEND_UMP
-        C.SIfDef "CONFIG_FLOUNDER_BACKEND_UMP" [
-            C.Return $ C.Call (drv_connect_fn_name "ump" n)
-                [ C.Variable intf_frameinfo_var,
-                  C.Variable intf_cont_var,
-                  C.Variable "st",
-                  C.Variable "ws",
-                  C.Variable "flags" ]
-        ]
-        -- #else
-        [ C.StmtList [
-             C.Ex $ C.Call "assert" [
-                 C.Unary C.Not $ C.StringConstant "UMP backend not enabled!"
-             ],
-             C.Return $ C.Variable "ERR_NOTIMP"
-          ]
-        ] ]
-    ]
-    where 
-        params = [ C.Param (C.Ptr $ C.Struct $ intf_frameinfo_type n) intf_frameinfo_var,
-                   C.Param (C.Ptr $ C.TypeName $ intf_bind_cont_type n) intf_cont_var,
-                   C.Param (C.Ptr $ C.TypeName "void") "st",
-                   C.Param (C.Ptr $ C.Struct "waitset") "ws",
-                   C.Param (C.TypeName "idc_bind_flags_t") "flags"]
-
-
--- bind continuation function
-bind_cont_def :: String -> String -> [BindBackend] -> C.Unit
-bind_cont_def ifn fn_name backends =
-    C.FunctionDef C.Static C.Void fn_name params [
-        C.SComment "This bind cont function uses the different backends in the following order:",
-        C.SComment $ unwords $ map flounder_backend backends,
-        C.SBlank,
-
-        localvar (C.Ptr $ C.Struct "flounder_generic_bind_attempt") "b"
-            (Just $ C.Variable "st"),
-        C.Switch driver_num cases
-            [C.Ex $ C.Call "assert" [C.Unary C.Not $ C.StringConstant "invalid state"]],
-        C.SBlank,
-        C.Label "out",
-        C.Ex $ C.CallInd (C.Cast (C.Ptr $ C.TypeName $ intf_bind_cont_type ifn)
-                                (bindst `C.DerefField` "callback"))
-                        [bindst `C.DerefField` "st", errvar, C.Variable intf_bind_var],
-        C.Ex $ C.Call "free" [bindst]
-    ]
-    where
-        params = [ C.Param (C.Ptr $ C.Void) "st",
-                   C.Param (C.TypeName "errval_t") "err",
-                   C.Param (C.Ptr $ C.Struct $ intf_bind_type ifn) intf_bind_var]
-        driver_num = bindst `C.DerefField` "driver_num"
-        bindst = C.Variable "b"
-        cases = [ C.Case (C.NumConstant $ toInteger n) (mkcase n)
-                  | n <- [0 .. length backends] ]
-
-        mkcase n
-            | n == 0 = try_next
-
-            | n == length backends = [
-                C.SIfDef config_prev_driver
-                    [C.If (test_cb_success prev_backend)
-                        -- success!
-                        [success_callback]
-                        -- failure, but clean up attempt
-                        [C.StmtList $ cleanup_bind prev_backend,
-                         C.If (C.Unary C.Not $ test_cb_try_next prev_backend)
-                            [fail_callback errvar]
-                            []]
-                    ]
-                    [],
-                fail_callback (C.Variable "FLOUNDER_ERR_GENERIC_BIND_NO_MORE_DRIVERS")
-                ]
-
-            | otherwise = [
-                C.SIfDef config_prev_driver
-                    [C.If (test_cb_success prev_backend)
-                        -- success!
-                        [success_callback]
-
-                        -- failure, cleanup and decide whether to continue
-                        [C.StmtList $ cleanup_bind prev_backend,
-                         C.If (test_cb_try_next prev_backend)
-                            [C.Goto ("try_next_" ++ show n)]
-                            [C.SComment "report permanent failure to user",
-                             fail_callback errvar]
-                            ],
-
-                     C.Label ("try_next_" ++ show n)
-                    ] [],
-
-                -- previous driver not enabled, just try the next
-                C.StmtList try_next]
-            where
-                prev_backend = backends !! (n - 1)
-                next_backend = backends !! n
-                config_prev_driver = "CONFIG_FLOUNDER_BACKEND_"
-                                ++ (map toUpper (flounder_backend prev_backend))
-                config_next_driver = "CONFIG_FLOUNDER_BACKEND_"
-                                ++ (map toUpper (flounder_backend next_backend))
-
-                try_next = [C.Ex $ C.PostInc driver_num,
-                            C.SIfDef config_next_driver
-                                [C.SComment "try next backend",
-                                 C.StmtList $ start_bind next_backend,
-                                 C.If (C.Call "err_is_fail" [errvar])
-                                    -- bind attempt failed
-                                    [C.StmtList $ cleanup_bind next_backend,
-                                     fail_callback errvar]
-                                    [C.ReturnVoid]]
-                                [C.SComment "skip non-enabled backend (fall through)"]]
-
-                fail_callback err = C.StmtList $
-                    (if err /= errvar
-                        then [C.Ex $ C.Assignment errvar err]
-                        else [])
-                    ++ [
-                        C.Ex $ C.Assignment (C.Variable intf_bind_var) (C.Variable "NULL"),
-                        C.Goto "out"]
-
-                success_callback = C.Goto "out"
-
-
-bind_fn_def :: String -> C.Unit
-bind_fn_def n = 
-    C.FunctionDef C.NoScope (C.TypeName "errval_t") (bind_fn_name n) params [
-        C.SComment "allocate state",
-        localvar (C.Ptr $ C.Struct "flounder_generic_bind_attempt") "b"
-            (Just $ C.Call "malloc" [C.SizeOfT $ C.Struct "flounder_generic_bind_attempt"]),
-        C.If (C.Binary C.Equals (C.Variable "b") (C.Variable "NULL"))
-            [C.Return $ C.Variable "LIB_ERR_MALLOC_FAIL"] [],
-        C.SBlank,
-        C.SComment "fill in binding state",
-        C.StmtList [C.Ex $ C.Assignment (C.Variable "b" `C.DerefField` dstf) srce
-                    | (dstf, srce) <- [
-                        ("iref", C.Variable "iref"),
-                        ("waitset", C.Variable "waitset"),
-                        ("driver_num", C.NumConstant 0),
-                        ("callback", C.Variable intf_cont_var),
-                        ("st", C.Variable "st"),
-                        ("flags", C.Variable "flags")]],
-        C.SBlank,
-        C.If (C.Binary C.BitwiseAnd (C.Variable "flags") (C.Variable "IDC_BIND_FLAG_MULTIHOP"))
-        [C.Ex $ C.Call (bind_cont_name2 n) [C.Variable "b", C.Variable "SYS_ERR_OK", C.Variable "NULL"]]
-        [C.Ex $ C.Call (bind_cont_name n) [C.Variable "b", C.Variable "SYS_ERR_OK", C.Variable "NULL"]],
-        C.SBlank,
-        C.Return $ C.Variable "SYS_ERR_OK"
-    ]
-    where 
-      params = [ C.Param (C.TypeName "iref_t") "iref",
-                 C.Param (C.Ptr $ C.TypeName $ intf_bind_cont_type n) intf_cont_var,
-                 C.Param (C.Ptr $ C.TypeName "void") "st",
-                 C.Param (C.Ptr $ C.Struct "waitset") "waitset",
-                 C.Param (C.TypeName "idc_bind_flags_t") "flags" ]
-
-----------------------------------------------------------------------------
--- everything that we need to know about a backend to attempt a generic bind
-----------------------------------------------------------------------------
-data BindBackend = BindBackend {
-    flounder_backend :: String,     -- name of the flounder backend
-    start_bind :: [C.Stmt],         -- code to attempt a bind
-    test_cb_success :: C.Expr,      -- expression to test if a bind succeeded (in the callback)
-    test_cb_try_next :: C.Expr,     -- expression to test if a bind might succeed with another backend
-    cleanup_bind :: [C.Stmt]        -- code to cleanup a failed bind
-}
-
--- the available bind backends
--- Cation: order of list matters (we will try to bind in that order)
-bind_backends :: String -> String -> [BindBackend]
-bind_backends ifn cont_fn_name = map (\i -> i ifn (C.Variable cont_fn_name)) 
-                    [lmp_bind_backend, 
-                     ump_ipi_bind_backend, 
-                     ump_bind_backend, 
-                     multihop_bind_backend]
-                                                     
--- backends in different order (prefer multihop over ump, etc.)
-multihop_bind_backends :: String -> String -> [BindBackend]
-multihop_bind_backends ifn cont_fn_name = map (\i -> i ifn (C.Variable cont_fn_name))
-                    [lmp_bind_backend, 
-                     multihop_bind_backend, 
-                     ump_ipi_bind_backend, 
-                     ump_bind_backend]
-
-bindst = C.Variable "b"
-binding = bindst `C.DerefField` "binding"
-iref = bindst `C.DerefField` "iref"        
-waitset = bindst `C.DerefField` "waitset"
-flags = bindst `C.DerefField` "flags"
-
-lmp_bind_backend ifn cont = 
-  BindBackend {
-    flounder_backend = "lmp",
-    start_bind = [
-        C.Ex $ C.Assignment binding $
-            C.Call "malloc" [C.SizeOfT $ C.Struct $ lmp_bind_type ifn],
-        C.Ex $ C.Call "assert" [C.Binary C.NotEquals binding (C.Variable "NULL")],
-        C.Ex $ C.Assignment errvar $
-            C.Call (lmp_bind_fn_name ifn) [binding, iref, cont, C.Variable "b", waitset,
-                                           flags,
-                                           C.Variable "DEFAULT_LMP_BUF_WORDS"]
-    ],
-    test_cb_success = C.Call "err_is_ok" [errvar],
-    test_cb_try_next = C.Binary C.Equals (C.Call "err_no" [errvar])
-                                         (C.Variable "MON_ERR_IDC_BIND_NOT_SAME_CORE"),
-    cleanup_bind = [ C.Ex $ C.Call "free" [binding] ]
-    }
-  
-ump_bind_backend ifn cont =   
-  BindBackend {
-    flounder_backend = "ump",
-    start_bind = [
-        C.Ex $ C.Assignment binding $
-            C.Call "malloc" [C.SizeOfT $ C.Struct $ UMP.bind_type ifn],
-        C.Ex $ C.Call "assert" [C.Binary C.NotEquals binding (C.Variable "NULL")],
-        C.Ex $ C.Assignment errvar $
-            C.Call (UMP.bind_fn_name ifn) [binding, iref, cont, C.Variable "b", waitset,
-                                           flags,
-                                           C.Variable "DEFAULT_UMP_BUFLEN",
-                                           C.Variable "DEFAULT_UMP_BUFLEN"]
-    ],
-    test_cb_success = C.Call "err_is_ok" [errvar],
-    test_cb_try_next = C.Variable "true",
-    cleanup_bind = [ C.Ex $ C.Call "free" [binding] ]
-    }
-  
-ump_ipi_bind_backend ifn cont = 
-  BindBackend {
-    flounder_backend = "ump_ipi",
-    start_bind = [
-        C.Ex $ C.Assignment binding $
-            C.Call "malloc" [C.SizeOfT $ C.Struct $ UMP_IPI.bind_type ifn],
-        C.Ex $ C.Call "assert" [C.Binary C.NotEquals binding (C.Variable "NULL")],
-        C.Ex $ C.Assignment errvar $
-            C.Call (UMP_IPI.bind_fn_name ifn) [binding, iref, cont, C.Variable "b", waitset,
-                                           flags,
-                                           C.Variable "DEFAULT_UMP_BUFLEN",
-                                           C.Variable "DEFAULT_UMP_BUFLEN"]
-    ],
-    test_cb_success = C.Call "err_is_ok" [errvar],
-    test_cb_try_next = C.Variable "true",
-    cleanup_bind = [ C.Ex $ C.Call "free" [binding] ]
-    }
-  
-multihop_bind_backend ifn cont = 
-  BindBackend {
-    flounder_backend = "multihop",
-    start_bind = [C.Ex $ C.Assignment binding $
-                         C.Call "malloc" [C.SizeOfT $ C.Struct $ Multihop.m_bind_type ifn],
-                         C.Ex $ C.Call "assert" [C.Binary C.NotEquals binding (C.Variable "NULL")],
-                         C.Ex $ C.Assignment errvar $
-                         C.Call (Multihop.m_bind_fn_name ifn) [binding, iref, cont, C.Variable "b", waitset, flags]],
-    test_cb_success = C.Call "err_is_ok" [errvar],
-    test_cb_try_next = C.Variable "true",
-    cleanup_bind = [ C.Ex $ C.Call "free" [binding] ]
-    }
-
--}
diff --git a/tools/sockeye/SockeyeDocBackend.hs b/tools/sockeye/SockeyeDocBackend.hs
deleted file mode 100644 (file)
index 47576b6..0000000
+++ /dev/null
@@ -1,21 +0,0 @@
-{- 
-   GCBackend: Flounder stub generator for generic code
-   
-  Part of Flounder: a message passing IDL for Barrelfish
-   
-  Copyright (c) 2007-2010, 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 SockeyeDocBackend where
-
-import qualified CAbsSyntax as C
-import SockeyeSyntax (Schema (Schema))
-
-compile :: String -> String -> SockeyeSyntax.Schema -> String
-compile infile outfile schema = 
-    ""
\ No newline at end of file
diff --git a/tools/sockeye/SockeyeHeaderBackend.hs b/tools/sockeye/SockeyeHeaderBackend.hs
deleted file mode 100644 (file)
index 887bf1f..0000000
+++ /dev/null
@@ -1,277 +0,0 @@
-{- 
-   GHBackend: Flounder stub generator for generic header files
-   
-  Part of Flounder: a message passing IDL for Barrelfish
-   
-  Copyright (c) 2007-2010, 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 SockeyeHeaderBackend where
-
-import Data.List
-import Data.Char
-
-import qualified CAbsSyntax as C
-import SockeyeSyntax
-
-
-import qualified Backend
-import BackendCommon
-
-
-add_fn_name n = ifscope n "add"
-
-
-------------------------------------------------------------------------
--- Language mapping: Create the generic header file for the interface
-------------------------------------------------------------------------
-
-compile :: String -> String -> Schema -> String
-compile infile outfile schema = 
-    unlines $ C.pp_unit $ sockeye_header_file infile schema
-
-
-header_file :: String -> Schema -> [C.Unit] -> C.Unit
-header_file infile schema@(Schema name _ _) body = 
-    let sym = "__SCHEMA_" ++ map toUpper name ++ "_H"
-    in
-      C.IfNDef sym ([ C.Define sym [] "1"] ++ body) []
-
-
-sockeye_header_file :: String -> Schema -> C.Unit
-sockeye_header_file infile intf = 
-    header_file infile intf (schema_header_body infile intf)
-
-
-schema_header_body :: String -> Schema -> [C.Unit]
-schema_header_body infile schema@(Schema name descr decls) = 
-    let
-        (types, facts, queries) = Backend.partitionTypesFactsQueries decls
-        --messages = rpcs_to_msgs messagedecls
-    in
-      [ schema_preamble infile name descr,
-        C.Blank,
-
-        C.Include C.Standard "skb/skb.h",
-        C.Blank,
-
-        C.MultiComment [ "Concrete type definitions" ],
-        C.UnitList $ define_types name types,
-        C.Blank,
-        C.Blank,
-
-        C.MultiComment [ "Fact attribute fields" ],
-        C.Blank,
-        C.UnitList [ fact_attributes name f | f <- facts ],
-        C.Blank,
-
-        C.MultiComment [ "Fact type signatures" ],
-        C.Blank,
-        C.UnitList [ fact_signature name f | f <- facts ],
-        C.Blank,
-
-        C.MultiComment [ "Query type signatures" ],
-        C.Blank,
-        C.UnitList [ query_signature name q | q <- queries ],
-        C.Blank
-      ]
-
-
-
---
--- Generate type definitions for each fact signature
---
-   
-
-
-
-fact_signature :: String -> FactDef -> C.Unit
-fact_signature sname f = C.UnitList [
-    C.MultiDoxy (["@brief  " ++ desc,
-                  ""] ++ param_desc),
-    C.FunctionDecl C.NoScope (C.TypeName "errval_t") name params,
-    C.Blank
-  ]
-  where
-    name = fact_sig_type sname "add" f
-    desc = fact_desc f
-    params = [C.Param (C.Ptr $ C.Struct $ (fact_attrib_type sname f)) "arg"]
-    param_desc = [ fact_param_desc a | a <- fact_args f ]
-    payload = case f of
-        Fact _ _ args -> [ fact_argdecl sname a | a <- args ]
-
-
-
-query_signature :: String -> QueryDef -> C.Unit
-query_signature sname q =
-  C.FunctionDecl C.NoScope (C.TypeName "errval_t") name params
-  where
-    name = query_sig_type sname q
-    params = concat payload
-    payload = case q of
-        Query _ _ args -> [ query_argdecl sname a | a <- args ]
-
-
-fact_attributes :: String -> FactDef -> C.Unit
-fact_attributes sname f = C.UnitList [
-    C.MultiDoxy (["Fact: " ++ name,
-                  "@brief  " ++ desc]),
-    C.StructDecl name params,
-    C.Blank,
-    C.DoxyComment ("typedef for the " ++ name ++ " attribute type"),
-    C.TypeDef (C.Struct name) (name ++ "_t"),
-    C.Blank,
-    fact_fmt_str sname f,
-    C.Blank
-  ]
-  where 
-    name = fact_attrib_type sname f
-    desc = fact_desc f
-    params = concat payload
-    payload = case f of
-        Fact _ _ args -> [ fact_attrib_decl sname a | a <- args ]
-
-
-attr_fmt_type_wr :: String -> FactAttribute -> String
-attr_fmt_type_wr sn (FAttrib t (Name n) d) = case t of
-    Builtin builtin ->  "\"%\" " ++ builtin_fmt_wr builtin
-    TypeVar name -> "\"typevar\""
-    FactType name -> type_c_define sn name "FMT_WRITE"
-    TypeAlias alias (Builtin builtin) -> "\"%\" " ++ builtin_fmt_rd builtin
-
-attr_fmt_type_rd :: String -> FactAttribute -> String
-attr_fmt_type_rd sn (FAttrib t (Name n) d) = case t of
-    Builtin builtin ->  "\"%\" " ++ builtin_fmt_rd builtin
-    TypeVar name -> "\"typevar\""
-    FactType name -> type_c_define sn name "FMT_READ"
-    TypeAlias alias (Builtin builtin) -> "\"%\" " ++ builtin_fmt_rd builtin
-
-attr_access_rd :: String -> String -> FactAttribute -> String
-attr_access_rd arg sn (FAttrib t (Name n) d) = case t of
-    FactType name -> type_c_define sn name "FIELDS(&("++"(" ++ arg ++ ")->" ++ n ++"))"
-    _ -> "(" ++ arg ++ ")->" ++ n
-
-fact_fmt_str :: String -> FactDef -> C.Unit
-fact_fmt_str sname f=  C.UnitList [
-    C.DoxyComment ("define for printing the " ++ name ++ " fact"),
-    (C.Define (type_c_define sname (fact_name f) "FMT_WRITE") [] params_wr),
-    C.DoxyComment ("define for reading the " ++ name ++ " fact"),
-    (C.Define (type_c_define sname (fact_name f) "FMT_READ") [] params_rd),
-    C.DoxyComment ("define for accessing the  " ++ name ++ "fact attributes"),
-    (C.Define (type_c_define sname (fact_name f) "FIELDS") [ "_arg" ] field_access),
-    C.Blank
-  ]
-  where
-    name = plfact_attrib_type sname f
-    desc = fact_desc f
-    params_wr = "\"" ++ name ++ "(\"" ++ (intercalate "\", \"" write) ++ "\")\""
-    write = case f of
-        Fact _ _ args -> [ (attr_fmt_type_wr sname a) | a <- args ]
-    params_rd = "\"" ++ name ++ "(\"" ++ (intercalate "\", \"" read) ++ "\")\""
-    read = case f of
-        Fact _ _ args -> [ (attr_fmt_type_rd sname a) | a <- args ]
-    field_access = (intercalate ", " fields)
-    fields = case f of
-        Fact _ _ args -> [ attr_access_rd "_arg" sname a | a <- args ]  
-
-{-
-
---
--- Generate a struct to hold the arguments of a message while it's being sent.
--- 
-msg_argstruct :: String -> [TypeDef] -> MessageDef -> C.Unit
-msg_argstruct ifname typedefs m@(RPC n args _) = 
-    C.StructDecl (msg_argstruct_name ifname n) 
-         (concat [ rpc_argdecl ifname a | a <- args ])
-msg_argstruct ifname typedefs m@(Message _ n [] _) = C.NoOp
-msg_argstruct ifname typedefs m@(Message _ n args _) =
-    let tn = msg_argstruct_name ifname n
-    in
-      C.StructDecl tn (concat [ msg_argstructdecl ifname typedefs a
-                               | a <- args ])
-
---
--- Generate a union of all the above
--- 
-intf_union :: String -> [MessageDef] -> C.Unit
-intf_union ifn msgs = 
-    C.UnionDecl (binding_arg_union_type ifn)
-         ([ C.Param (C.Struct $ msg_argstruct_name ifn n) n
-            | m@(Message _ n a _) <- msgs, 0 /= length a ]
-          ++
-          [ C.Param (C.Struct $ msg_argstruct_name ifn n) n
-            | m@(RPC n a _) <- msgs, 0 /= length a ]
-         )
-
---
--- Generate a struct defn for a vtable for the interface
---
-intf_vtbl :: String -> Direction -> [MessageDef] -> C.Unit
-intf_vtbl n d ml = 
-    C.StructDecl (intf_vtbl_type n d) [ intf_vtbl_param n m d | m <- ml ]
-
-intf_vtbl_param :: String -> MessageDef -> Direction ->  C.Param
-intf_vtbl_param ifn m d = C.Param (C.Ptr $ C.TypeName $ msg_sig_type ifn m d) (msg_name m)
-
---
------------------------------------------------------------------
--- Code to generate concrete type definitions
------------------------------------------------------------------
-
--}
-
-define_types :: String -> [TypeDef] -> [C.Unit]
-define_types schemaName types = 
-    [ define_type schemaName t | t <- types ]
-
-define_type :: String -> TypeDef -> C.Unit
-define_type sname (TAliasT newType originType) =
-    C.TypeDef (type_c_type sname $ Builtin originType) (type_c_name1 sname newType)
-
-{-
-This enumeration:
-\begin{verbatim}
-typedef enum {
-    foo, bar, baz
-} some_enum;
-\end{verbatim}
-
-Generates the following code:
-\begin{verbatim}
-enum ifname_some_enum_t {
-    ifname_some_enum_t_foo = 1,
-    ifname_some_enum_t_bar = 2,
-    ifname_some_enum_t_baz = 3,
-}
-\end{verbatim}
--}
-
-
-define_type sname (TEnum name elements) = 
-    C.EnumDecl (type_c_name1 sname name) 
-         [ C.EnumItem (type_c_enum sname e) Nothing | e <- elements ]
-
-
-   
-
-{-
-A typedef'd alias:
-\begin{verbatim}
-typedef uint32 alias_type;
-\end{verbatim}
-
-Should compile to:
-\begin{verbatim}
-typedef uint32_t ifname_alias_type_t;
-\end{verbatim}
--}
-
-define_type sname (TAlias newType originType) =
-    C.TypeDef (type_c_type sname originType) (type_c_name1 sname newType)
-
-
diff --git a/tools/sockeye/SockeyeParser.hs b/tools/sockeye/SockeyeParser.hs
deleted file mode 100644 (file)
index e128b24..0000000
+++ /dev/null
@@ -1,202 +0,0 @@
-{- 
-   Parser.hs: Parser for the Sockeye schema definition language
-                      
-   Part of Sockeye: a strawman device definition DSL for Barrelfish
-   
-  Copyright (c) 2015, 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, Haldeneggsteig 4, CH-8092 Zurich. Attn: Systems Group.
--}
-
-module SockeyeParser where
-
-import SockeyeSyntax
-
-import Prelude 
-import Text.ParserCombinators.Parsec as Parsec
-import Text.ParserCombinators.Parsec.Expr
-import Text.ParserCombinators.Parsec.Pos
-import qualified Text.ParserCombinators.Parsec.Token as P
-import Text.ParserCombinators.Parsec.Language( javaStyle )
-import Data.Char
-import Numeric
-import Data.List
-import Text.Printf
-
-parse_intf predefDecls name filename = parseFromFile (intffile predefDecls name) filename
-parse_include predefDecls filename = parseFromFile (includefile predefDecls) filename
-
-lexer = P.makeTokenParser (javaStyle
-                           { P.reservedNames = [ "fact",
-                                                 "query",
-                                                 "key",
-                                                 "unique"
-                                               ]
-                           , P.reservedOpNames = ["*","/","+","-"]
-                           , P.commentStart = "/*"
-                           , P.commentEnd = "*/"
-                           })
-
-whiteSpace = P.whiteSpace lexer 
-reserved   = P.reserved lexer
-identifier = P.identifier lexer
-stringLit  = P.stringLiteral lexer
-comma      = P.comma lexer
-commaSep   = P.commaSep lexer
-commaSep1  = P.commaSep1 lexer
-parens     = P.parens lexer
-braces     = P.braces lexer
-squares    = P.squares lexer
-semiSep    = P.semiSep lexer
-symbol     = P.symbol lexer
-natural    = P.natural lexer
-
-builtinTypes = map show [UInt8 ..] ++ ["int"] -- int is legacy -AB
-
--- identifyBuiltin :: [(String, Declaration)] -> String -> TypeRef
-identifyBuiltin typeDcls typeName = 
-    do {
-      if typeName `elem` builtinTypes then
-          return $ Builtin $ (read typeName::TypeBuiltin)
-      else 
-          case typeName `lookup` typeDcls of
-            Just (Typedef (TAlias new orig)) -> return $ TypeAlias new orig
---            Just x -> trace (show x) return $ TypeVar typeName
-            Nothing -> return $ UnknownType typeName
--- This needs to go to SockeyeTools:
---                do {
---                ; pos <- getPosition
---                -- This is ugly, I agree:
---                ; return $ error ("Use of undeclared type '" ++ typeName ++ "' in "
---                                  ++ show (sourceName pos) ++ " at l. "
---                                  ++ show (sourceLine pos) ++ " col. "
---                                  ++ show (sourceColumn pos))
---                }
-    }
-
-intffile predefDecls name = do { whiteSpace
-             ; i <- pSchema predefDecls name
-             ; return i
-              }
-
-includefile predefDecls = do { whiteSpace
-             ; typeDecls <- typeDeclaration predefDecls
-             ; return typeDecls
-              }
-
-pSchema predefDecls _ = do { reserved "schema"
-           ; name <- identifier 
-           ; descr <- option name stringLit
-           ; decls <- braces $ do {
-                               ; typeDecls <- typeDeclaration predefDecls
-                               ; factDecls <- many1 $ pFact typeDecls
-                               ; queryDecls <- many $ pQuery typeDecls
-                               ; return ((map snd typeDecls) ++ factDecls ++ queryDecls)
-                               }
-           ; symbol ";" <?> " ';' missing from end of " ++ name ++ " interface specification"
-           ;  return (Schema name descr decls)
-           }
-
-
-typeDeclaration typeDcls = do {
-                           ; decl <- try (do {
-                                               ; x <- typedefinition typeDcls
-                                               ; return $ Just x
-                                               })
-                                    <|> return Nothing
-                           ; case decl of 
-                               Nothing -> return typeDcls
-                               Just x -> typeDeclaration (x : typeDcls)
-                           }
-
-pFact typeDcls = do { def <- pFct typeDcls
-                    ; return $ Factdef def
-                    }
-
-pQuery typeDcls = do {def <- pQry typeDcls
-                   ; return $ Querydef def
-                   }
-
-pQry typeDcls = do { reserved "query"
-                   ; i <- identifier
-                   ; d <- option i stringLit
-                   ; attrib <- braces $ commaSep (queryParams typeDcls)
-                   ; symbol ";"
-                   ; return $ Query i d attrib
-                   }
-
-
-pFct typeDcls = do { reserved "fact"
-                   ; i <- identifier
-                   ; d <- option i stringLit
-                   ; attrib <- braces $ do { attrDecls <- many $ factAttribs typeDcls
-                                           ; return attrDecls
-                                           }
-                   ; symbol ";"
-                   ; return $ Fact i d attrib
-                   }
-
-
-factAttribs typeDecls = do { b <-factAttribType typeDecls
-                           ; i <- identifier
-                           ; d <- option i stringLit
-                           ; symbol ";"
-                           ; return (FAttrib b (Name i) d)
-                           }
---- XXX: verify that the fact is already defined
-factAttribTypeRef typeDecls = do {
-                                 t <- identifier 
-                               --  ; b <- identifyBuiltin typeDecls t
-                                 ; return $ FactType t
-                              --   ; return b
-                                 }
-
-factAttribTypeBultIn typeDecls = do { t <- identifier 
-                                    ; b <- identifyBuiltin typeDecls t
-                                    ; return b
-                                    }
-
-
-factAttribType typeDcls = try (factAttribTypeBultIn typeDcls)
-                        <|> (factAttribTypeRef typeDcls)
-
-
-
-
-queryParams typeDecls = do { i <- identifier
-                           ; symbol "="
-                           ; v <- identifier
-                           ; symbol ";"
-                           ; return $ QParam (Name i) i 
-                           }
-
-typedefinition typeDcls = do { whiteSpace
-                             ; reserved "typedef"
-                             ; (name, typeDef) <- typedef_body typeDcls
-                             ; symbol ";"
-                             ; return (name, Typedef typeDef)
-                             }
-
-typedef_body typeDcls = try enum_typedef
-                        <|> (alias_typedef typeDcls)
-
-enum_typedef = do { reserved "enum"
-                  ; v <- braces $ commaSep1 identifier
-                  ; i <- identifier
-                  ; return (i, (TEnum i v))
-                  }
-
-alias_typedef typeDcls = do { t <- identifier
-                            ; i <- identifier
-                            ; b <- identifyBuiltin typeDcls t
-                            ; return (i, (TAlias i b))
-                            }
-
-integer = P.integer lexer
diff --git a/tools/sockeye/SockeyeSyntax.lhs b/tools/sockeye/SockeyeSyntax.lhs
deleted file mode 100644 (file)
index fedce6e..0000000
+++ /dev/null
@@ -1,284 +0,0 @@
-%include polycode.fmt
-
-%if false
-  Sockeye: an fact specification language
-   
-  Copyright (c) 2015 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, Universitaetsstrasse 6, CH-8092 Zurich. 
-  Attn: Systems Group.
-%endif
-
-
-\section{The Abstract Syntax}
-
-In this module, we define the combinators to embed the Flounder
-language into Haskell. So, we will mix the design the Abstract-Syntax
-Tree with the definition of some handy combinators.
-
-> module SockeyeSyntax where
-
-
-
-% =============================================================================
-% Schema
-% =============================================================================
-
-\subsection{Interface Header}
-
-First, we define the abstract syntax of our embedded language. At the
-top-level is the \emph{schema} definition. It consists of a @name@
-and a @description@. It contains a list of\emph{facts} or \emph{queries}.
-
-> data Schema = Schema String String [ Declaration ]
->   deriving (Show)
->
-> schema :: String -> String -> [ Declaration ] -> Schema
-> schema name description declarations = 
->     Schema name description declarations
-
-
-Finally, various getters:
-
-> schemaName :: Schema -> String
-> schemaName (Schema name _ _) = name
-
-\subsection{Declarations}
-
-A declaration is either a \emph{type definition}, a \emph{fact
-definition} or a \emph{query definition}. In the next subsections, 
-we define these terms in turn.
-
-> data Declaration = Typedef TypeDef
->                  | Factdef FactDef
->                  | Querydef QueryDef
->   deriving (Show)
-
-% =============================================================================
-% Types
-% =============================================================================
-
-
-\subsubsection{Declaring types}
-
-We can define new types out of existing ones thanks to five
-constructs:
-\begin{description}
-        \item[Enumeration:] like C @enum@, defines a sum-type over some elements
-        \item[Alias:] redefine the name of an already defined type
-\end{description}
-
-> data TypeDef = TEnum String [String] 
->              | TAlias String TypeRef
->              | TAliasT String TypeBuiltin
->   deriving (Show)
-
-In this definition, we notice the presence of @TypeRef@: indeed, when
-we construct a new type, it can use either built-in types, such as
-@uint8_t@, or previously defined types, identified by their name.
-
-> data TypeRef = Builtin TypeBuiltin
->              | TypeVar String
->              | FactType String
->              | TypeAlias String TypeRef
->              | UnknownType String
->     deriving (Show)
-
-The builtin types being:
-
-> data TypeBuiltin = UInt8
->                  | UInt16
->                  | UInt32
->                  | UInt64
->                  | UIntPtr
->                  | Int8
->                  | Int16
->                  | Int32
->                  | Int64
->                  | IntPtr
->                  | Size
->                  | Char
->                  | Bool
->                  | String
->                  | IRef
->                    deriving (Enum, Eq)
-
-Which are shown with:
-
-> instance Show TypeBuiltin where
->     show UInt8 = "uint8"
->     show UInt16 = "uint16"
->     show UInt32 = "uint32"
->     show UInt64 = "uint64"
->     show UIntPtr = "uintptr"
->     show Int8 = "int8"
->     show Int16 = "int16"
->     show Int32 = "int32"
->     show Int64 = "int64"
->     show IntPtr = "intptr"
->     show Size = "size"
->     show Bool = "bool"
->     show String = "string"
->     show Char = "char"
->     show IRef = "iref"
-
-> instance Read TypeBuiltin where
->     readsPrec _ = \s -> case s of 
->                                "uint8" -> [(UInt8, "")]
->                                "uint16" -> [(UInt16, "")]
->                                "uint32" -> [(UInt32, "")]
->                                "uint64" -> [(UInt64, "")]
->                                "uintptr" -> [(UIntPtr, "")]
->                                "int8" -> [(Int8, "")]
->                                "int16" -> [(Int16, "")]
->                                "int32" -> [(Int32, "")]
->                                "int64" -> [(Int64, "")]
->                                "intptr" -> [(IntPtr, "")]
->                                "size" -> [(Size, "")]
->                                "bool" -> [(Bool, "")]
->                                "string" -> [(String, "")]
->                                "char" -> [(Char, "")]
->                                "iref" -> [(IRef, "")]
->                                _ -> error  $ "Undefined builtin type " ++ s
-
-
-> builtin_fmt_wr :: TypeBuiltin -> String
-> builtin_fmt_wr (UInt8) = "PRIu8"
-> builtin_fmt_wr (UInt16) = "PRIu16"
-> builtin_fmt_wr (UInt32) = "PRIu32"
-> builtin_fmt_wr (UInt64) = "PRIu64"
-> builtin_fmt_wr (UIntPtr) = "PRIuPTR"
-> builtin_fmt_wr (Int8) = "PRIi8"
-> builtin_fmt_wr (Int16) = "PRIi16"
-> builtin_fmt_wr (Int32) = "PRIi32"
-> builtin_fmt_wr (Int64) = "PRIi64"
-> builtin_fmt_wr (IntPtr) = "PRIuPTR"
-> builtin_fmt_wr (Size) = "PRIuSIZE"
-> builtin_fmt_wr (Bool) = "\"i\""
-> builtin_fmt_wr (String) = "\"s\""
-> builtin_fmt_wr (Char) = "\"c\""
-> builtin_fmt_wr (IRef) = "PRIuIREF"
-
-
-> builtin_fmt_rd :: TypeBuiltin -> String
-> builtin_fmt_rd (UInt8) = "SCNu8"
-> builtin_fmt_rd (UInt16) = "SCNu16"
-> builtin_fmt_rd (UInt32) = "SCNu32"
-> builtin_fmt_rd (UInt64) = "SCNu64"
-> builtin_fmt_rd (UIntPtr) = "SCNuPTR"
-> builtin_fmt_rd (Int8) = "SCNi8"
-> builtin_fmt_rd (Int16) = "SCNi16"
-> builtin_fmt_rd (Int32) = "SCNi32"
-> builtin_fmt_rd (Int64) = "SCNi64"
-> builtin_fmt_rd (IntPtr) = "SCNuPTR"
-> builtin_fmt_rd (Size) = "SCNuSIZE"
-> builtin_fmt_rd (Bool) = "\"i\""
-> builtin_fmt_rd (String) = "\"s\""
-> builtin_fmt_rd (Char) = "\"c\""
-> builtin_fmt_rd (IRef) = "SCNuIREF"
-
-Hence, we can define:
-
-> isBuiltin :: TypeRef -> Bool
-> isBuiltin (Builtin _) = True
-> isBuiltin _ = False
-
-And the usual combinators:
-
-> uint8, uint16, uint32, uint64, uintptr :: TypeRef
-> uint8 = Builtin UInt8
-> uint16 = Builtin UInt16
-> uint32 = Builtin UInt32
-> uint64 = Builtin UInt64
-> uintptr = Builtin UIntPtr
-
-> int8, int16, int32, int64, intptr :: TypeRef
-> int8 = Builtin Int8
-> int16 = Builtin Int16
-> int32 = Builtin Int32
-> int64 = Builtin Int64
-> intptr = Builtin IntPtr
-
-> size, string, iref :: TypeRef
-> size = Builtin Size
-> string = Builtin String
-> iref = Builtin IRef
-
-> var :: String -> TypeRef
-> var typeRef = TypeVar typeRef
-
-> als :: String -> TypeBuiltin -> TypeRef
-> als typeRef origin = TypeAlias typeRef (Builtin origin)
-
-Then, we can build a type definition out of these special cases with:
-
-> typedef :: TypeDef -> Declaration
-> typedef typeDefinition = Typedef typeDefinition
-
-
-Here's a utility function to resolve a named type (which may be an alias) to
-its canonical definition:
-
-
-
-\paragraph{Enumeration}
-
-An enumeration is, as always, identified by a @name@. The content of
-an enumeration is a list of tags, the @elements@.
-
-> enum :: [String] -> String -> TypeDef
-> enum elements name = TEnum name elements
-
-\paragraph{Aliasing}
-
-Finally, we can do type aliasing: we can give a @newName@ to a type,
-which was previously known as @originalName@. Note that the names are
-switched between the combinator and the data-type.
-
-> alias :: TypeRef -> String -> TypeDef
-> alias originalName newName = TAlias newName originalName
-
-
-% =============================================================================
-% Facts
-% =============================================================================
-
-\subsubsection{Declaration of a Fact}
-A @fact@ is identified by a @name@ and has a @description@ and a set of 
-@attributes@ which are described by a list of @FactAttribute@
-
-
-> data FactDef = Fact String String [ FactAttribute ]
->   deriving (Show)
-
-> fact :: String -> String -> [ FactAttribute ] -> Declaration
-> fact name desc args = Factdef $ Fact name desc args
-
-> data FactAttribute = FAttrib TypeRef Variable String
->     deriving (Show)
->
-> data Variable = Name String
->                 deriving (Show)
->
-
-% =============================================================================
-% Queries
-% =============================================================================
-
-\subsubsection{Declaration of a Query}
-
-A @fact@ is identified by a @name@ and has a description and a set of 
-@attributes@ which are described by a list of @FactArgument@
-
-> data QueryDef = Query String String [ QueryParam ]
->   deriving (Show)
-
-> query :: String -> String -> [ QueryParam ] -> Declaration
-> query name desc args = Querydef $ Query name desc args 
-
-> data QueryParam = QParam Variable String
->     deriving (Show)
-
diff --git a/tools/sockeye/SockeyeTools.hs b/tools/sockeye/SockeyeTools.hs
deleted file mode 100644 (file)
index 82cc016..0000000
+++ /dev/null
@@ -1,55 +0,0 @@
-{-
-  SockeyeTools.hs: Tools for the Sockeye parser
-
-  Part of Sockeye: a strawman device definition DSL for Barrelfish
-
-  Copyright (c) 2015, 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, CAB F.78, Universitaetstr. 6, CH-8092 Zurich,
-  Attn: Systems Group.
--}
-
-module SockeyeTools where
-import SockeyeSyntax
-
-import qualified Data.Map as Map
-
-collectTypes :: Schema -> (Map.Map String TypeRef)
-collectTypes (Schema name doc ast) = Map.unions (map collectTypes_Declaration ast)
-
-collectTypes_Declaration :: Declaration -> Map.Map String TypeRef
-collectTypes_Declaration (Typedef typeDef) = collectTypes_TypeDef typeDef
-collectTypes_Declaration (Factdef factDef) = collectTypes_FactDef factDef
-collectTypes_Declaration (Querydef queryDef) = collectTypes_QueryDef queryDef
-
-collectTypes_TypeDef :: TypeDef -> Map.Map String TypeRef
-collectTypes_TypeDef (TEnum _ _) = Map.empty
-collectTypes_TypeDef (TAlias name ref) = Map.singleton name ref
-
-collectTypes_FactDef :: FactDef -> Map.Map String TypeRef
-collectTypes_FactDef (Fact name _ _) = Map.singleton name (FactType name)
-
-collectTypes_QueryDef :: QueryDef -> Map.Map String TypeRef
-collectTypes_QueryDef (Query _ _ _) = Map.empty
-
-rewireTypes :: Schema -> Map.Map String TypeRef -> Schema
-rewireTypes ast decls = rewireTypes_Schema ast decls
-
-rewireTypes_Schema (Schema name doc ast) decls =
-    Schema name doc [rewireTypes_Declaration i decls | i <- ast]
-
-rewireTypes_Declaration (Typedef t) _ = Typedef t
-rewireTypes_Declaration (Factdef f) decl = Factdef (rewireTypes_FactDef f decl)
-
-rewireTypes_FactDef f@(Fact name doc fattribs) decls =
-    Fact name doc [rewireTypes_FactAttribute i decls | i <- fattribs]
-
-rewireTypes_FactAttribute (FAttrib t var doc) decls =
-    FAttrib (rewireTypes_TypeRef t decls) var doc
-
-rewireTypes_TypeRef (UnknownType name) decls = decls Map.! name
-rewireTypes_TypeRef t _ = t
diff --git a/tools/sockeye/intro.tex b/tools/sockeye/intro.tex
deleted file mode 100644 (file)
index 88c5ee1..0000000
+++ /dev/null
@@ -1,90 +0,0 @@
-\section{Introduction}
-
-\subsection{Closure Data-Structures}
-
-Let assume we are defining an interface named \emph{if}, with the
-following \emph{call} messages:
-\begin{itemize}
-  \item \verb!init_device_irq!
-  \item \verb!init_device!
-  \item \verb!get_cap!
-\end{itemize}
-
-And the following \emph{response} messages:
-\begin{itemize}
-  \item \verb!transmit_next_cap_response!
-  \item \verb!transmit_next_cap_error!
-  \item \verb!init_device_error!
-  \item \verb!init_device_response!
-\end{itemize}
-
-This will generates the following data-structures in \verb!if.h!. 
-
-\subsubsection{Server-side}
-
-\begin{description}
-  \item \verb!if_service_response!:
-    \begin{itemize}
-    \item \verb!if_server_response_vtbl *! \verb!f!
-      \begin{description}
-        \item \verb!if_server_response_vtbl!: (auto-generated)
-          \begin{itemize}
-            \item \verb!if_transmit_next_cap_response_fn *! \verb!transmit_next_cap_response!
-            \item \verb!if_transmit_next_cap_error_fn *! \verb!transmit_next_cap_error!
-            \item \verb!if_init_device_error_fn *! \verb!init_device_error!
-            \item \verb!if_init_device_response_fn *! \verb!init_device_response!
-            \item \verb!chips_disconnect_handler_t! \verb!_disconnect!
-          \end{itemize}
-      \end{description}
-    \item \verb!chips_connection *! conn
-    \item \verb!if_service *! clp
-      \begin{description}
-        \item \verb!if_service!:
-          \begin{itemize}
-            \item \verb!if_server_call_vtbl *! \verb!f!
-              \begin{description}
-                \item \verb!if_server_call_vtbl!: (to be filled)
-                  \begin{itemize}
-                    \item \verb!if_init_device_fn *! \verb!init_device!
-                    \item \verb!if_get_cap_fn *! \verb!get_cap!
-                    \item \verb!chips_disconnect_handler_t! \verb!_disconnect!
-                    \item \verb!chips_listen_callback_t! \verb!_listening!
-                  \end{itemize}
-              \end{description}
-            \item \verb!void *! \verb!st!
-          \end{itemize}
-      \end{description}
-    \end{itemize}
-\end{description}
-
-
-\subsubsection{Client-side}
-
-\begin{description}
-  \item \verb!if_client_response!:
-    \begin{itemize}
-      \item \verb!if_client_response_vtbl *! \verb!f!
-        \begin{description}
-          \item \verb!if_client_response_vtbl!: (to be filled)
-            \begin{itemize}
-            \item \verb!if_transmit_next_cap_response_fn *! \verb!transmit_next_cap_response!
-            \item \verb!if_transmit_next_cap_error_fn *! \verb!transmit_next_cap_error!
-            \item \verb!if_init_device_error_fn *! \verb!init_device_error!
-            \item \verb!if_init_device_response_fn *! \verb!init_device_response!
-            \item \verb!chips_disconnect_handler_t! \verb!_disconnect!
-            \item \verb!if_connected_cb! \verb!_connected!
-            \end{itemize}
-        \end{description}
-      \item \verb!if_client_call_vtbl *! \verb!f!
-        \begin{description}
-        \item \verb!if_client_call_vtbl!: (auto-generated)
-          \begin{itemize}
-          \item \verb!if_init_device_fn *! \verb!init_device!
-          \item \verb!if_get_cap_fn *! \verb!get_cap!
-          \item \verb!chips_disconnect_handler! \verb!_disconnect!
-          \end{itemize}
-        \end{description}
-      \item \verb!chips_connection *! \verb!conn!
-      \item \verb!void *! \verb!st!
-    \end{itemize}
-\end{description}
diff --git a/tools/sockeye/notes.txt b/tools/sockeye/notes.txt
deleted file mode 100644 (file)
index dccce24..0000000
+++ /dev/null
@@ -1,89 +0,0 @@
-
-Interface name: foo
-Method: bar( uint64_t par1, string par2 );
-
-
-// Enumeration for procedure numbers
-typedef enum foo_procnums_t { 
-       foo_bar_procnum,
-};
-
-// Structure to hold all the arguments of a message
-// We need these to keep them around while we unmarshal or marshal
-// them if they don't fit into a single underlying message
-//
-typedef struct foo_bar_args_t { 
-       ...
-               };
-
-// Type of a given method call
-typedef errval_t (foo_bar_method_t)(foo_binding_t *binding, uint64_t par1, const char *par2 )
-
-// Union holding all args
-union foo_arg_union {
-    struct foo_bar_args bar_args;
-    <other method args>
-               };
-
-// The binding structure, for both sides.
-typedef struct foo_binding_t { 
-       foo_bar_method_t bar;
-       <other methods>
-       ...;
-       // Continuation information for fragmented messages
-       int             _tx_current_arg; // Arg we are currently marshalling
-       int             _tx_arg_progress; // How far through it?
-       union { 
-               struct foo_bar_args bar_args;
-               <other method args>
-               } _tx_args;
-       foo_bar_method_t _bar_handler;
-       <other methods>
-       ...;
-       idc_error_t     _error;  // Points to user code
-       idc_register_fn _register;
-       idc_control_fn  _control;
-       idc_malloc_fn   _malloc;
-       idc_free_fn     _free;
-       // Continuation information for fragmented messages
-       int             _rx_current_arg; // Arg we are currently unmarshalling
-       int             _rx_arg_progress; // How far through it?
-       union { 
-               struct foo_bar_args_t bar_args;
-               <other method args>
-               } _rx_args;
-                       
-};
-
-// Callbacks for export completion, and incoming bind request.
-typedef void (foo_export_cl *)( void *st, iref_t i, error_t e )
-typedef int (foo_connect_cl *)( void *st, foo_binding_t *b,
-                               ipc_flags_t f )
-
-
-// Export function itself.
-int foo_export( foo_export_cl ec, foo_connect_cl cc );
-
-
-// Callbacks for completed bind request
-typedef void (foo_bind_cl *)( foo_binding_t *binding, error_t e );
-
-// Bind functions. 
-int foo_bind( iref_t i, foo_bind_cl bc );
-int foo_bind_ump( iref_t i, foo_bind_cl bc );
-int foo_bind_lmp( iref_t i, foo_bind_cl bc );
-
-// Static proxy method to send a message of a given type
-static foo_bar_method_t foo_ump_send_fn;
-
-// Static proxy function to continue sending a message of a given
-// type; only needed if the message might not fit into a single transport
-// frame. 
-static foo_ump_send_continuation_t foo_bar_send_continuation;
-
-// Function called when something might be arriving
-static foo_ump_recv_fn(foo_binding_t *binding);
-
-// Function called to dispatch a function
-static foo_ump_bar_recv(foo_binding_t *binding);
-static foo_ump_bar_recv_continuation(foo_binding_t *binding);
diff --git a/tools/sockeye/tutorial.lhs b/tools/sockeye/tutorial.lhs
deleted file mode 100644 (file)
index 80c86d9..0000000
+++ /dev/null
@@ -1,35 +0,0 @@
-\documentclass{article}
-
-%include polycode.fmt
-
-%if false
-  Flounder2: an even more simpler IDL for Barrelfish
-   
-  Copyright (c) 2009 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, Haldeneggsteig 4, CH-8092 Zurich. Attn: Systems Group.
-%endif
-
-\title{Flounder 2}
-\author{}
-\date{}
-
-\begin{document}
-
-\maketitle
-
-\newpage
-
-\tableofcontents
-
-\include{intro}
-\include{Syntax}
-\include{Backend}
-%% \include{HeaderBackend}
-%% \include{CodeBackend}
-\include{Main}
-
-\end{document}