Update benchmark for new union syntax.

c++/src/capnproto/benchmark/capnproto-eval.c++

@@ -36,16 +36,16 @@ int32_t makeExpression(Expression::Builder exp, uint depth) {
 
   if (fastRand(8) < depth) {
     left = fastRand(128) + 1;
-    exp.setLeftValue(left);
+    exp.getLeft().setValue(left);
   } else {
-    left = makeExpression(exp.initLeftExpression(), depth + 1);
+    left = makeExpression(exp.getLeft().initExpression(), depth + 1);
   }
 
   if (fastRand(8) < depth) {
     right = fastRand(128) + 1;
-    exp.setRightValue(right);
+    exp.getRight().setValue(right);
   } else {
-    right = makeExpression(exp.initRightExpression(), depth + 1);
+    right = makeExpression(exp.getRight().initExpression(), depth + 1);
   }
 
   switch (exp.getOp()) {
@@ -66,21 +66,21 @@ int32_t makeExpression(Expression::Builder exp, uint depth) {
 int32_t evaluateExpression(Expression::Reader exp) {
   int32_t left = 0, right = 0;
 
-  switch (exp.whichLeft()) {
-    case Expression::Left::LEFT_VALUE:
-      left = exp.getLeftValue();
+  switch (exp.getLeft().which()) {
+    case Expression::Left::VALUE:
+      left = exp.getLeft().getValue();
       break;
-    case Expression::Left::LEFT_EXPRESSION:
-      left = evaluateExpression(exp.getLeftExpression());
+    case Expression::Left::EXPRESSION:
+      left = evaluateExpression(exp.getLeft().getExpression());
       break;
   }
 
-  switch (exp.whichRight()) {
-    case Expression::Right::RIGHT_VALUE:
-      right = exp.getRightValue();
+  switch (exp.getRight().which()) {
+    case Expression::Right::VALUE:
+      right = exp.getRight().getValue();
       break;
-    case Expression::Right::RIGHT_EXPRESSION:
-      right = evaluateExpression(exp.getRightExpression());
+    case Expression::Right::EXPRESSION:
+      right = evaluateExpression(exp.getRight().getExpression());
       break;
   }
 

c++/src/capnproto/benchmark/eval.capnp

@@ -32,13 +32,15 @@ enum Operation {
 struct Expression {
   op@0: Operation;
 
-  union left @1;
-  leftValue@2 in left: Int32;
-  leftExpression@3 in left: Expression;
+  left @1 union {
+    value@2: Int32;
+    expression@3: Expression;
+  }
 
-  union right @4;
-  rightValue@5 in right: Int32;
-  rightExpression@6 in right: Expression;
+  right @4 union {
+    value@5: Int32;
+    expression@6: Expression;
+  }
 }
 
 struct EvaluationResult {

compiler/capnproto-compiler.cabal

@@ -21,7 +21,8 @@ executable capnpc
                    data-binary-ieee754,
                    filepath,
                    directory,
-                   syb
+                   syb,
+                   transformers
   ghc-options:     -Wall -fno-warn-missing-signatures
   other-modules:
                    Lexer,

compiler/src/Compiler.hs

@@ -29,6 +29,7 @@ import Token(Located(Located))
 import Parser(parseFile)
 import qualified Data.Map as Map
 import Data.Map((!))
+import qualified Data.Set as Set
 import qualified Data.List as List
 import Data.Maybe(mapMaybe, fromMaybe)
 import Text.Parsec.Pos(SourcePos, newPos)
@@ -699,13 +700,13 @@ compileParam scope (name, typeExp, defaultValue) = do
         Nothing -> return Nothing
     return (name, typeDesc, defaultDesc)
 
-compileFile name decls =
+compileFile name decls importMap =
     feedback (\desc -> do
         (members, memberMap, options, statements) <- compileChildDecls (DescFile desc) decls
         requireNoDuplicateNames decls
         return FileDesc
             { fileName = name
-            , fileImports = []
+            , fileImports = Map.elems importMap
             , fileAliases    = [d | DescAlias     d <- members]
             , fileConstants  = [d | DescConstant  d <- members]
             , fileEnums      = [d | DescEnum      d <- members]
@@ -713,16 +714,49 @@ compileFile name decls =
             , fileInterfaces = [d | DescInterface d <- members]
             , fileOptions = options
             , fileMemberMap = memberMap
-            , fileImportMap = undefined
+            , fileImportMap = importMap
             , fileStatements = statements
             })
 
-parseAndCompileFile filename text = result where
-    (decls, parseErrors) = parseFile filename text
-    -- Here we're doing the copmile step even if there were errors in parsing, and just combining
-    -- all the errors together.  This may allow the user to fix more errors per compiler iteration,
-    -- but it might also be confusing if a parse error causes a subsequent compile error, especially
-    -- if the compile error ends up being on a line before the parse error (e.g. there's a parse
-    -- error in a type definition, causing a not-defined error on a field trying to use that type).
-    -- TODO:  Re-evaluate after getting some experience on whether this is annoing.
-    result = statusAddErrors parseErrors (compileFile filename decls)
+dedup :: Ord a => [a] -> [a]
+dedup = Set.toList . Set.fromList
+
+parseAndCompileFile :: Monad m
+                    => FilePath                                -- Name of this file.
+                    -> String                                  -- Content of this file.
+                    -> (String -> m (Either FileDesc String))  -- Callback to import other files.
+                    -> m (Status FileDesc)                     -- Compiled file and/or errors.
+parseAndCompileFile filename text importCallback = do
+    let (decls, parseErrors) = parseFile filename text
+        importNames = dedup $ concatMap declImports decls
+        doImport (Located pos name) = do
+            result <- importCallback name
+            case result of
+                Left desc -> return (succeed (name, desc))
+                Right err -> return
+                    (makeError pos (printf "Couldn't import \"%s\": %s" name err))
+
+    importStatuses <- mapM doImport importNames
+
+    return (do
+        -- We are now in the Status monad.
+
+        -- Report errors from parsing.
+        -- We do the compile step even if there were errors in parsing, and just combine all the
+        -- errors together.  This may allow the user to fix more errors per compiler iteration, but
+        -- it might also be confusing if a parse error causes a subsequent compile error,
+        -- especially if the compile error ends up being on a line before the parse error (e.g.
+        -- there's a parse error in a type definition, causing a not-defined error on a field
+        -- trying to use that type).
+        -- TODO:  Re-evaluate after getting some experience on whether this is annoing.
+        Active () parseErrors
+
+        -- Report errors from imports.
+        -- Similar to the above, we're continuing with compiling even if imports fail, but the
+        -- problem above probably doesn't occur in this case since global imports usually appear
+        -- at the top of the file anyway.  The only annoyance is seeing a long error log because
+        -- of one bad import.
+        imports <- doAll importStatuses
+
+        -- Compile the file!
+        compileFile filename decls $ Map.fromList imports)

compiler/src/Grammar.hs

@@ -24,6 +24,7 @@
 module Grammar where
 
 import Token (Located)
+import Data.Maybe (maybeToList)
 
 data DeclName = AbsoluteName (Located String)
               | RelativeName (Located String)
@@ -31,9 +32,19 @@ data DeclName = AbsoluteName (Located String)
               | MemberName DeclName (Located String)
               deriving (Show)
 
+declNameImport :: DeclName -> Maybe (Located String)
+declNameImport (AbsoluteName _) = Nothing
+declNameImport (RelativeName _) = Nothing
+declNameImport (ImportName s) = Just s
+declNameImport (MemberName parent _) = declNameImport parent
+
 data TypeExpression = TypeExpression DeclName [TypeExpression]
                     deriving (Show)
 
+typeImports :: TypeExpression -> [Located String]
+typeImports (TypeExpression name params) =
+    maybeToList (declNameImport name) ++ concatMap typeImports params
+
 data FieldValue = VoidFieldValue
                 | BoolFieldValue Bool
                 | IntegerFieldValue Integer
@@ -71,3 +82,17 @@ declarationName (UnionDecl n _ _)       = Just n
 declarationName (InterfaceDecl n _)     = Just n
 declarationName (MethodDecl n _ _ _ _)  = Just n
 declarationName (OptionDecl _ _)        = Nothing
+
+declImports :: Declaration -> [Located String]
+declImports (AliasDecl _ name) = maybeToList $ declNameImport name
+declImports (ConstantDecl _ t _) = typeImports t
+declImports (EnumDecl _ decls) = concatMap declImports decls
+declImports (EnumValueDecl _ _ decls) = concatMap declImports decls
+declImports (StructDecl _ decls) = concatMap declImports decls
+declImports (FieldDecl _ _ t _) = typeImports t
+declImports (UnionDecl _ _ decls) = concatMap declImports decls
+declImports (InterfaceDecl _ decls) = concatMap declImports decls
+declImports (MethodDecl _ _ params t decls) =
+    concat [paramsImports, typeImports t, concatMap declImports decls] where
+        paramsImports = concat [typeImports pt | (_, pt, _) <- params]
+declImports (OptionDecl name _) = maybeToList $ declNameImport name

compiler/src/Main.hs

@@ -27,9 +27,13 @@ import System.Environment
 import System.Console.GetOpt
 import System.Exit(exitFailure, exitSuccess)
 import System.IO(hPutStr, stderr)
-import System.FilePath(takeDirectory)
+import System.FilePath(takeDirectory, combine)
 import System.Directory(createDirectoryIfMissing, doesDirectoryExist)
 import Control.Monad
+import Control.Monad.IO.Class(liftIO)
+import Control.Exception(IOException, catch)
+import Control.Monad.Trans.State(StateT, state, modify, execStateT)
+import Prelude hiding (catch)
 import Compiler
 import Util(delimit)
 import Text.Parsec.Pos
@@ -96,35 +100,77 @@ main = do
             exitFailure)
     mapM_ verifyDirectoryExists [dir | (_, dir) <- outputs]
 
-    mapM_ (handleFile outputs isVerbose) files
+    CompilerState failed _ <-
+        execStateT (mapM_ (handleFile outputs isVerbose) files) (CompilerState False Map.empty)
+    when failed exitFailure
 
 parseOutputArg :: String -> Opt
 parseOutputArg str = case List.elemIndex ':' str of
     Just i -> let (lang, _:dir) = splitAt i str in OutputOpt lang (Map.lookup lang generatorFns) dir
     Nothing -> OutputOpt str (Map.lookup str generatorFns) "."
 
-handleFile :: [(GeneratorFn, FilePath)] -> Bool -> FilePath -> IO ()
-handleFile outputs isVerbose filename = do
-    text <- readFile filename
-    case parseAndCompileFile filename text of
+data ImportState = ImportInProgress | ImportFailed | ImportSucceeded FileDesc
+type ImportStateMap = Map.Map String ImportState
+data CompilerState = CompilerState Bool ImportStateMap
+type CompilerMonad a = StateT CompilerState IO a
+
+importFile :: Bool -> FilePath -> CompilerMonad (Either FileDesc String)
+importFile isVerbose filename = do
+    fileState <- state (\s@(CompilerState f m) -> case Map.lookup filename m of
+        d@Nothing -> (d, CompilerState f (Map.insert filename ImportInProgress m))
+        d -> (d, s))
+
+    case fileState of
+        Just ImportFailed -> return $ Right "File contained errors."
+        Just ImportInProgress -> return $ Right "File cyclically imports itself."
+        Just (ImportSucceeded d) -> return $ Left d
+        Nothing -> do
+            result <- readAndParseFile isVerbose filename
+            modify (\(CompilerState f m) -> case result of
+                Left desc -> CompilerState f (Map.insert filename (ImportSucceeded desc) m)
+                Right _ -> CompilerState True (Map.insert filename ImportFailed m))
+            return result
+
+readAndParseFile isVerbose filename = do
+    textOrError <- liftIO $ catch (fmap Left $ readFile filename)
+        (\ex -> return $ Right $ show (ex :: IOException))
+
+    case textOrError of
+        Right err -> return $ Right err
+        Left text -> parseFile isVerbose filename text
+
+parseFile isVerbose filename text = do
+    let importCallback name = do
+            let path = tail $ combine ('/':filename) name
+            importFile isVerbose path
+
+    status <- parseAndCompileFile filename text importCallback
+    case status of
         Active desc [] -> do
-            when isVerbose (print desc)
-
-            let write dir (name, content) = do
-                let outFilename = dir ++ "/" ++ name
-                createDirectoryIfMissing True $ takeDirectory outFilename
-                LZ.writeFile outFilename content
-            let generate (generatorFn, dir) = do
-                files <- generatorFn desc
-                mapM_ (write dir) files
-            mapM_ generate outputs
-
+            when isVerbose (liftIO $ print desc)
+            return $ Left desc
         Active _ e -> do
-            mapM_ printError (List.sortBy compareErrors e)
-            exitFailure
+            liftIO $ mapM_ printError (List.sortBy compareErrors e)
+            return $ Right "File contained errors."
         Failed e -> do
-            mapM_ printError (List.sortBy compareErrors e)
-            exitFailure
+            liftIO $ mapM_ printError (List.sortBy compareErrors e)
+            return $ Right "File contained errors."
+
+handleFile :: [(GeneratorFn, FilePath)] -> Bool -> FilePath -> CompilerMonad ()
+handleFile outputs isVerbose filename = do
+    result <- importFile isVerbose filename
+
+    case result of
+        Right _ -> return ()
+        Left desc -> do
+            let write dir (name, content) = do
+                    let outFilename = dir ++ "/" ++ name
+                    createDirectoryIfMissing True $ takeDirectory outFilename
+                    LZ.writeFile outFilename content
+                generate (generatorFn, dir) = do
+                    files <- generatorFn desc
+                    mapM_ (write dir) files
+            liftIO $ mapM_ generate outputs
 
 compareErrors a b = compare (errorPos a) (errorPos b)