diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,3 @@ +2019-11-22 Ivan Perez + * Version bump (3.1). + * Remove ExternFun (#6). diff --git a/copilot-language.cabal b/copilot-language.cabal --- a/copilot-language.cabal +++ b/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.0.1 +version: 3.1 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -23,7 +23,7 @@ stability: Experimental category: Language, Embedded build-type: Simple -extra-source-files: README.md +extra-source-files: README.md, CHANGELOG source-repository head type: git @@ -40,8 +40,8 @@ , mtl >= 2.0 && < 3 , ghc-prim >= 0.3 && < 0.6 - , copilot-core >= 3.0.1 && < 3.1 - , copilot-theorem >= 3.0 && < 3.1 + , copilot-core >= 3.1 && < 3.2 + , copilot-theorem >= 3.1 && < 3.2 exposed-modules: Copilot , Copilot.Language diff --git a/src/Copilot/Language/Analyze.hs b/src/Copilot/Language/Analyze.hs --- a/src/Copilot/Language/Analyze.hs +++ b/src/Copilot/Language/Analyze.hs @@ -36,7 +36,6 @@ | DropIndexOverflow | ReferentialCycle | DropMaxViolation - | NestedExternFun | NestedArray | TooMuchRecursion | InvalidField @@ -52,8 +51,6 @@ show ReferentialCycle = badUsage $ "Referential cycle!" show DropMaxViolation = badUsage $ "Maximum drop violation (" ++ show (maxBound :: DropIdx) ++ ")!" - show NestedExternFun = badUsage $ - "An external function cannot take another external function or external array as an argument. Try defining a stream, and using the stream values in the other definition." show NestedArray = badUsage $ "An external function cannot take another external function or external array as an argument. Try defining a stream, and using the stream values in the other definition." show TooMuchRecursion = badUsage $ @@ -135,18 +132,6 @@ Const _ -> return () Drop k e1 -> analyzeDrop (fromIntegral k) e1 Extern _ _ -> return () - ExternFun _ args me -> - checkInterp >> checkArgs - where - checkInterp = case me of - Nothing -> return () - Just e -> go seenExt nodes' e - checkArgs = case seenExt of - NoExtern -> mapM_ (\(Arg a) -> - go SeenFun nodes' a) args - SeenFun -> throw NestedExternFun - SeenArr -> throw NestedArray - SeenStruct-> throw InvalidField Local e f -> go seenExt nodes' e >> go seenExt nodes' (f (Var "dummy")) Var _ -> return () @@ -209,8 +194,6 @@ data ExternEnv = ExternEnv { externVarEnv :: [(String, C.SimpleType)] , externArrEnv :: [(String, C.SimpleType)] - , externFunEnv :: [(String, C.SimpleType)] - , externFunArgs :: [(String, [C.SimpleType])] , externStructEnv :: [(String, C.SimpleType)] , externStructArgs :: [(String, [C.SimpleType])] } @@ -222,27 +205,19 @@ analyzeExts :: ExternEnv -> IO () analyzeExts ExternEnv { externVarEnv = vars , externArrEnv = arrs - , externFunEnv = funs - , externFunArgs = args , externStructEnv = datastructs , externStructArgs = struct_args } = do -- symbol names redeclared? findDups vars arrs - findDups vars funs --findDups vars struct_args findDups vars datastructs - findDups arrs funs --findDups arrs struct_args findDups arrs datastructs - --findDups funs struct_args - findDups funs datastructs -- conflicting types? conflictingTypes vars conflictingTypes arrs - conflictingTypes funs -- symbol names given different number of args and right types? - funcArgCheck args --funcArgCheck struct_args funcArgCheck struct_args @@ -299,7 +274,7 @@ specExts :: IORef Env -> Spec' a -> IO ExternEnv specExts refStreams spec = do env <- foldM triggerExts - (ExternEnv [] [] [] [] [] []) + (ExternEnv [] [] [] []) (triggers $ runSpec spec) foldM observerExts env (observers $ runSpec spec) @@ -333,18 +308,6 @@ Extern name _ -> let ext = ( name, getSimpleType stream ) in return env { externVarEnv = ext : externVarEnv env } - - ExternFun name args me -> do - env' <- case me of - Nothing -> return env - Just e -> go nodes env e - env'' <- foldM (\env'' (Arg arg_) -> go nodes env'' arg_) - env' args - let argTypes = map (\(Arg arg_) -> getSimpleType arg_) args - let fun = (name, getSimpleType stream) - return env'' { externFunEnv = fun : externFunEnv env'' - , externFunArgs = (name, argTypes) : externFunArgs env'' - } Local e _ -> go nodes env e Var _ -> return env diff --git a/src/Copilot/Language/Operators/Extern.hs b/src/Copilot/Language/Operators/Extern.hs --- a/src/Copilot/Language/Operators/Extern.hs +++ b/src/Copilot/Language/Operators/Extern.hs @@ -17,9 +17,7 @@ , externI16 , externI32 , externI64 - , externF , externD - , externFun , funArg -- * Deprecated. ) where @@ -35,9 +33,6 @@ extern :: Typed a => String -> Maybe [a] -> Stream a extern = Extern -externFun :: Typed a => String -> [Arg] -> Maybe (Stream a) -> Stream a -externFun = ExternFun - -- | Deprecated. funArg :: Typed a => Stream a -> Arg funArg = Arg @@ -62,7 +57,5 @@ externI32 = extern externI64 :: String -> Maybe [Int64] -> Stream Int64 externI64 = extern -externF :: String -> Maybe [Float] -> Stream Float -externF = extern externD :: String -> Maybe [Double] -> Stream Double externD = extern diff --git a/src/Copilot/Language/Reify.hs b/src/Copilot/Language/Reify.hs --- a/src/Copilot/Language/Reify.hs +++ b/src/Copilot/Language/Reify.hs @@ -199,15 +199,6 @@ ------------------------------------------------------ - ExternFun cs args interpExpr -> do - args' <- mapM mkFunArg args - w <- case interpExpr of - Nothing -> return Nothing - Just e -> liftM Just (go e) - return $ Core.ExternFun typeOf cs args' w Nothing - - ------------------------------------------------------ - Op1 op e -> do w <- go e return $ Core.Op1 op w diff --git a/src/Copilot/Language/Stream.hs b/src/Copilot/Language/Stream.hs --- a/src/Copilot/Language/Stream.hs +++ b/src/Copilot/Language/Stream.hs @@ -31,8 +31,6 @@ => Int -> Stream a -> Stream a Extern :: Typed a => String -> Maybe [a] -> Stream a - ExternFun :: Typed a - => String -> [Arg] -> Maybe (Stream a) -> Stream a Local :: (Typed a, Typed b) => Stream a -> (Stream a -> Stream b) -> Stream b Var :: Typed a