packages feed

copilot-language (empty) → 0.1

raw patch · 25 files changed

+1614/−0 lines, 25 filesdep +arraydep +basedep +containerssetup-changed

Dependencies added: array, base, containers, copilot-core, data-reify, ghc-prim, mtl

Files

+ LICENSE view
@@ -0,0 +1,29 @@+2009+BSD3 License terms++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer.++Redistributions in binary form must reproduce the above copyright+notice, this list of conditions and the following disclaimer in the+documentation and/or other materials provided with the distribution.++Neither the name of the developers nor the names of its contributors+may be used to endorse or promote products derived from this software+without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT OWNER OR+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ copilot-language.cabal view
@@ -0,0 +1,64 @@+cabal-version:       >=1.10+name:                copilot-language+version:             0.1+synopsis:            A Haskell-embedded DSL for monitoring hard real-time+                     distributed systems.+description:         Blah blah blah...+license:             BSD3+license-file:        LICENSE+author:              Lee Pike, Robin Morisset, Alwyn Goodloe, Sebastian Niller,+                     Nis Nordby Wegmann+maintainer:          niswegmann@gmail.com+stability:           Experimental+category:            Language, Embedded+build-type:          Simple++source-repository head+    type:       git+    location:   git://github.com/niswegmann/copilot-language.git++library+  default-language: Haskell2010++  hs-source-dirs: src++  build-depends:+    array,+    base >= 4.0 && < 5,+    containers >= 0.4 && < 1,+    data-reify >= 0.6,+    mtl >= 2.0 && < 3,+    ghc-prim >= 0.2 && < 0.3,+    copilot-core+  exposed-modules:+    Copilot+    Copilot.Language+    Copilot.Language.Error+    Copilot.Language.Interpret+    Copilot.Language.Operators.Boolean+    Copilot.Language.Operators.Cast+    Copilot.Language.Operators.Constant+    Copilot.Language.Operators.Eq+    Copilot.Language.Operators.Extern+    Copilot.Language.Operators.Local+    Copilot.Language.Operators.Integral+    Copilot.Language.Operators.Mux+    Copilot.Language.Operators.Ord+    Copilot.Language.Operators.Temporal+    Copilot.Language.Operators.BitWise+    Copilot.Language.Prelude+    Copilot.Language.Reify+--    Copilot.Language.Reify.Graph++  other-modules:+    Copilot.Language.Analyze+    Copilot.Language.Stream+    Copilot.Language.Spec+    System.Mem.StableName.Dynamic+    System.Mem.StableName.Dynamic.Map++  ghc-options:+    -fwarn-tabs+    -auto-all+    -caf-all+    -Wall
+ src/Copilot.hs view
@@ -0,0 +1,13 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++-- |++module Copilot+  ( module Copilot.Language+  ) where++import Copilot.Language++--------------------------------------------------------------------------------
+ src/Copilot/Language.hs view
@@ -0,0 +1,58 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++-- |++module Copilot.Language+  ( module Data.Int+  , module Data.Word+  , module Copilot.Core+  , module Copilot.Language.Error+  , module Copilot.Language.Interpret+  , module Copilot.Language.Operators.Boolean+  , module Copilot.Language.Operators.Cast+  , module Copilot.Language.Operators.Constant+  , module Copilot.Language.Operators.Eq+  , module Copilot.Language.Operators.Extern+  , module Copilot.Language.Operators.Local+  , module Copilot.Language.Operators.Integral+  , module Copilot.Language.Operators.Mux+  , module Copilot.Language.Operators.Ord+  , module Copilot.Language.Operators.Temporal+  , module Copilot.Language.Operators.BitWise+  , Spec+  , Stream+  , observer+  , trigger+  , arg+  , prettyPrint+  ) where++import Data.Int hiding (Int)+import Data.Word+import Copilot.Core (Name, Typed)+import qualified Copilot.Core.PrettyPrint as PP+import Copilot.Language.Error+import Copilot.Language.Interpret+import Copilot.Language.Operators.Boolean+import Copilot.Language.Operators.Cast+import Copilot.Language.Operators.Constant+import Copilot.Language.Operators.Eq+import Copilot.Language.Operators.Extern+import Copilot.Language.Operators.Integral+import Copilot.Language.Operators.Local+import Copilot.Language.Operators.Mux+import Copilot.Language.Operators.Ord+import Copilot.Language.Operators.Temporal+import Copilot.Language.Operators.BitWise+import Copilot.Language.Reify+import Copilot.Language.Spec (Spec, trigger, arg, observer)+import Copilot.Language.Stream (Stream)++--------------------------------------------------------------------------------++prettyPrint :: Spec -> IO ()+prettyPrint e = fmap PP.prettyPrint (reify e) >>= putStr++--------------------------------------------------------------------------------
+ src/Copilot/Language/Analyze.hs view
@@ -0,0 +1,149 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GADTs #-}++-- | Copilot specification sanity check.++module Copilot.Language.Analyze+  ( AnalyzeException (..)+  , analyze+  ) where++import Control.Exception (Exception, throw)+import Copilot.Language.Spec+import Copilot.Core (DropIdx)+import Copilot.Language.Stream (Stream (..), FunArg (..))+import Data.IORef+import Data.Typeable+import System.Mem.StableName.Dynamic+import System.Mem.StableName.Dynamic.Map (Map)+import qualified System.Mem.StableName.Dynamic.Map as M++--------------------------------------------------------------------------------++data AnalyzeException+  = DropAppliedToNonAppend+  | DropIndexOverflow+  | ReferentialCycle+  | DropMaxViolation+  | NestedExternFun+  | NestedArray+  deriving Typeable++instance Show AnalyzeException where+  show DropAppliedToNonAppend = "Drop applied to non-append operation!"+  show DropIndexOverflow      = "Drop index overflow!"+  show ReferentialCycle       = "Referential cycle!"+  show DropMaxViolation       = "Maximum drop violation (" ++ +                                  show (maxBound :: DropIdx) ++ ")!"+  show NestedExternFun        = +    "Extern function takes an extern function or extern array as an argument!"+  show NestedArray            = +    "Extern array takes an extern function or extern array as an argument!"++instance Exception AnalyzeException++--------------------------------------------------------------------------------++type Env = Map ()++--------------------------------------------------------------------------------++analyze :: Spec -> IO ()+analyze spec =+  do+    refStreams <- newIORef M.empty+    mapM_ (analyzeTrigger  refStreams) (triggers  (runSpec spec))+    mapM_ (analyzeObserver refStreams) (observers (runSpec spec))++--------------------------------------------------------------------------------++analyzeTrigger :: IORef Env -> Trigger -> IO ()+analyzeTrigger refStreams (Trigger _ e0 args) =+  analyzeExpr refStreams e0 >> mapM_ analyzeTriggerArg args++  where++  analyzeTriggerArg :: TriggerArg -> IO ()+  analyzeTriggerArg (TriggerArg e) = analyzeExpr refStreams e++--------------------------------------------------------------------------------++analyzeObserver :: IORef Env -> Observer -> IO ()+analyzeObserver refStreams (Observer _ e) = analyzeExpr refStreams e++--------------------------------------------------------------------------------++data SeenExtern = NoExtern+                | SeenFun+                | SeenArr++--------------------------------------------------------------------------------++analyzeExpr :: IORef Env -> Stream a -> IO ()+analyzeExpr refStreams = go NoExtern M.empty ++  where++  go :: SeenExtern -> Env -> Stream b -> IO ()+  go seenExt nodes e0 =+    do+      dstn <- makeDynStableName e0+      assertNotVisited e0 dstn nodes+      let nodes' = M.insert dstn () nodes+      case e0 of+        Append _ _ e       -> analyzeAppend refStreams dstn e+        Const _            -> return ()+        Drop k e1          -> analyzeDrop (fromIntegral k) e1+        Local e f          -> go seenExt nodes' e >> +                              go seenExt nodes' (f (Var "dummy"))+        Op1 _ e            -> go seenExt nodes' e+        Op2 _ e1 e2        -> go seenExt nodes' e1 >> +                              go seenExt nodes' e2+        Op3 _ e1 e2 e3     -> go seenExt nodes' e1 >> +                              go seenExt nodes' e2 >> +                              go seenExt nodes' e3+        ExternFun _ args   -> case seenExt of +                                NoExtern -> mapM_ (\(FunArg a) -> +                                                      go SeenFun nodes' a) args+                                SeenFun  -> throw NestedExternFun+                                SeenArr  -> throw NestedArray+        ExternArray _ idx  -> case seenExt of +                                NoExtern -> go SeenArr nodes' idx+                                SeenFun  -> throw NestedExternFun+                                SeenArr  -> throw NestedArray+        _                  -> return ()++  assertNotVisited :: Stream a -> DynStableName -> Env -> IO ()+  assertNotVisited (Append _ _ _) _    _     = return ()+  assertNotVisited _              dstn nodes =+    case M.lookup dstn nodes of+      Just () -> throw ReferentialCycle+      Nothing -> return ()++--------------------------------------------------------------------------------++analyzeAppend :: IORef Env -> DynStableName -> Stream a -> IO ()+analyzeAppend refStreams dstn e =+  do+    streams <- readIORef refStreams+    case M.lookup dstn streams of+      Just () -> return ()+      Nothing ->+        do+          modifyIORef refStreams $ M.insert dstn ()+          analyzeExpr refStreams e++--------------------------------------------------------------------------------++analyzeDrop :: Int -> Stream a -> IO ()+analyzeDrop k (Append xs _ _)+  | k >= length xs                         = throw DropIndexOverflow+  | k > fromIntegral (maxBound :: DropIdx) = throw DropMaxViolation+  | otherwise                              = return ()+analyzeDrop _ _                            = throw DropAppliedToNonAppend++--------------------------------------------------------------------------------
+ src/Copilot/Language/Error.hs view
@@ -0,0 +1,16 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++module Copilot.Language.Error +  ( impossible+  , badUsage ) where++impossible :: String -> String -> a+impossible function package = +  error $ "Impossible error in function " ++ function ++ ", in package " ++ +    package ++ ".  Please email Lee Pike at <lee pike @ gmail . com> " +++    "(remove spaces) or file a bug report on github.com."++badUsage :: String -> a+badUsage msg = error $ "Copilot error: " ++ msg ++ "."
+ src/Copilot/Language/Interpret.hs view
@@ -0,0 +1,97 @@+{- Copyright (c) 2011 National Institute of Aerospace / Galois, Inc. -}++{-# LANGUAGE GADTs, FlexibleInstances #-}++-- | The interpreter.++module Copilot.Language.Interpret+  ( Input+  , csv+  , interpret +  , var+  , array+  , func+  ) where++import Copilot.Core.Expr (Name)+import Copilot.Core.Type (Typed, typeOf)+import qualified Copilot.Core as C+import Copilot.Core.Interpret (ExtEnv (..))+import Copilot.Core.Type.Dynamic (toDynF)+import qualified Copilot.Core.Interpret as I++import Copilot.Language.Spec (Spec, observer)+import Copilot.Language.Stream (Stream)+import Copilot.Language.Reify++import Data.List (foldl')++--------------------------------------------------------------------------------++data Input where+  -- External variables.+  Var  :: Typed a => String -> [a] -> Input+  -- External arrays (list of lists).+  Arr  :: Typed a => String -> [[a]] -> Input+  -- External functions (streams).+  Func :: Typed a => String -> Stream a -> Input++var :: Typed a => String -> [a] -> Input+var = Var++array :: Typed a => String -> [[a]] -> Input+array = Arr++func :: Typed a => String -> Stream a -> Input+func = Func++--------------------------------------------------------------------------------++csv :: Integer -> [Input] -> Spec -> IO ()+csv i input_ spec = do+  putStrLn "Note: CSV format does not output observers."+  interpret' I.CSV i input_ spec++--------------------------------------------------------------------------------++-- | Much slower, but pretty-printed interpreter output.  +interpret :: Integer -> [Input] -> Spec -> IO ()+interpret = interpret' I.Table++interpret' :: I.Format -> Integer -> [Input] -> Spec -> IO ()+interpret' format i inputs spec = do+  coreSpec <- reify spec+  fexts    <- funcExts+  putStrLn $ I.interpret format (fromIntegral i) (unionExts fexts) coreSpec++  where+  unionExts :: [(Name, C.Spec)] -> ExtEnv+  unionExts fexts = ExtEnv { varEnv  = varEnv varArrExts+                           , arrEnv  = arrEnv varArrExts+                           , funcEnv = fexts+                           }++  -- We do the two folds below over the data type separately, since one+  -- component is monadic.+  funcExts :: IO [(Name, C.Spec)]+  funcExts = +    let (names, specs) = unzip $ foldl' envf [] inputs in+    do ss <- sequence specs+       return $ zip names ss+    where+    envf :: [(Name, IO C.Spec)] -> Input -> [(Name, IO C.Spec)]+    envf acc (Func name strm) = +      (name, reify $ observer name strm) : acc+    envf acc _ = acc++  varArrExts :: ExtEnv+  varArrExts = foldl' env (ExtEnv [] [] []) inputs+    where +    env :: ExtEnv -> Input -> ExtEnv+    env acc (Var name xs) = +      acc { varEnv = (name, toDynF typeOf xs) : varEnv acc } +    env acc (Arr name xs) = +      acc { arrEnv = (name, map (toDynF typeOf) xs) : arrEnv acc }+    env acc _ = acc++--------------------------------------------------------------------------------
+ src/Copilot/Language/Operators/BitWise.hs view
@@ -0,0 +1,40 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++{-# OPTIONS_GHC -fno-warn-orphans #-}++module Copilot.Language.Operators.BitWise+  ( Bits ( (.&.), complement, (.|.) )+  , (.^.)+  , (.<<.)+  , (.>>.)+  ) where++import Copilot.Core ( Typed, typeOf )+import qualified Copilot.Core as Core+import Copilot.Language.Stream+import qualified Prelude as P+import Data.Bits++instance ( Typed a, Bits a ) => Bits ( Stream a ) where+  (.&.)      = Op2 ( Core.BwAnd typeOf )+  complement = Op1 ( Core.BwNot typeOf )+  (.|.)      = Op2 ( Core.BwOr  typeOf )+  xor        = Op2 ( Core.BwXor typeOf )+  shiftL     = P.error "shiftL undefined, for left-shifting use .<<."+  shiftR     = P.error "shiftR undefined, for right-shifting use .>>."+  rotate     = P.error "tbd: rotate"+  bitSize    = P.error "tbd: bitSize"+  isSigned   = P.error "tbd: issigned"+++-- Avoid redefinition of the Operators.Boolean xor+(.^.) :: ( Bits a ) => a -> a -> a+(.^.) = xor+++(.<<.), (.>>.) :: ( Bits a, Typed a, Typed b, P.Integral b ) =>+                    Stream a -> Stream b -> Stream a+(.<<.) = Op2 ( Core.BwShiftL typeOf typeOf )+(.>>.) = Op2 ( Core.BwShiftR typeOf typeOf )
+ src/Copilot/Language/Operators/Boolean.hs view
@@ -0,0 +1,59 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++-- |++module Copilot.Language.Operators.Boolean+  ( (&&)+  , (||)+  , not+  , true+  , false+  , xor+  , (==>)+  ) where++import qualified Copilot.Core as Core+import Copilot.Language.Prelude+import Copilot.Language.Operators.Constant (constant)+import Copilot.Language.Stream+import qualified Prelude as P++--------------------------------------------------------------------------------++true :: Stream Bool+true = constant True++false :: Stream Bool+false = constant False++infix 4 &&++(&&) :: Stream Bool -> Stream Bool -> Stream Bool+(Const False) && _ = false+_ && (Const False) = false+(Const True) && y  = y+x && (Const True)  = x+x && y             = Op2 Core.And x y++infix 4 ||++(||) :: Stream Bool -> Stream Bool -> Stream Bool+(Const True) || _  = true+_ || (Const True)  = true+(Const False) || y = y+x || (Const False) = x+x || y             = Op2 Core.Or x y++not :: Stream Bool -> Stream Bool+not (Const c) = (Const $ P.not c)+not x         = Op1 Core.Not x++xor :: Stream Bool -> Stream Bool -> Stream Bool+xor x y = ( not x && y ) || ( x && not y )++(==>) :: Stream Bool -> Stream Bool -> Stream Bool+x ==> y = not x || y++--------------------------------------------------------------------------------
+ src/Copilot/Language/Operators/Cast.hs view
@@ -0,0 +1,140 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++{-# LANGUAGE MultiParamTypeClasses #-}++-- | Type-safe casting operators.++module Copilot.Language.Operators.Cast +  ( cast ) where++import qualified Copilot.Core.Operators as C+import Copilot.Core.Type+import Copilot.Language.Stream++import Data.Int+import Data.Word++--------------------------------------------------------------------------------++class Cast a b where+  cast :: (Typed a, Typed b) => Stream a -> Stream b++--------------------------------------------------------------------------------++castBool :: (Num a, Typed a) => Stream Bool -> Stream a+castBool (Const bool) = Const $ if bool then 1 else 0+castBool x            = Op3 (C.Mux typeOf) x 1 0++--------------------------------------------------------------------------------++instance Cast Bool Bool where+  cast = id+instance Cast Bool Word8 where+  cast = castBool+instance Cast Bool Word16 where+  cast = castBool+instance Cast Bool Word32 where+  cast = castBool+instance Cast Bool Word64 where+  cast = castBool++instance Cast Bool Int8 where+  cast = castBool+instance Cast Bool Int16 where+  cast = castBool+instance Cast Bool Int32 where+  cast = castBool+instance Cast Bool Int64 where+  cast = castBool++--------------------------------------------------------------------------------++castIntegral :: (Integral a, Typed a, Num b, Typed b) => Stream a -> Stream b+castIntegral (Const x) = Const (fromIntegral x)+castIntegral x         = Op1 (C.Cast typeOf typeOf) x++--------------------------------------------------------------------------------++instance Cast Word8 Word8 where+  cast = castIntegral+instance Cast Word8 Word16 where+  cast = castIntegral+instance Cast Word8 Word32 where+  cast = castIntegral+instance Cast Word8 Word64 where+  cast = castIntegral++instance Cast Word8 Int16 where+  cast = castIntegral+instance Cast Word8 Int32 where+  cast = castIntegral+instance Cast Word8 Int64 where+  cast = castIntegral++--------------------------------------------------------------------------------++instance Cast Word16 Word16 where+  cast = castIntegral+instance Cast Word16 Word32 where+  cast = castIntegral+instance Cast Word16 Word64 where+  cast = castIntegral++instance Cast Word16 Int32 where+  cast = castIntegral+instance Cast Word16 Int64 where+  cast = castIntegral++--------------------------------------------------------------------------------++instance Cast Word32 Word16 where+  cast = castIntegral+instance Cast Word32 Word32 where+  cast = castIntegral+instance Cast Word32 Word64 where+  cast = castIntegral++instance Cast Word32 Int64 where+  cast = castIntegral++--------------------------------------------------------------------------------++instance Cast Word64 Word64 where+  cast = castIntegral++--------------------------------------------------------------------------------++instance Cast Int8 Int8 where+  cast = castIntegral+instance Cast Int8 Int16 where+  cast = castIntegral+instance Cast Int8 Int32 where+  cast = castIntegral+instance Cast Int8 Int64 where+  cast = castIntegral++--------------------------------------------------------------------------------++instance Cast Int16 Int16 where+  cast = castIntegral+instance Cast Int16 Int32 where+  cast = castIntegral+instance Cast Int16 Int64 where+  cast = castIntegral++--------------------------------------------------------------------------------++instance Cast Int32 Int32 where+  cast = castIntegral+instance Cast Int32 Int64 where+  cast = castIntegral++--------------------------------------------------------------------------------++instance Cast Int64 Int64 where+  cast = castIntegral++--------------------------------------------------------------------------------+
+ src/Copilot/Language/Operators/Constant.hs view
@@ -0,0 +1,19 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++-- | Constants.++module Copilot.Language.Operators.Constant+  ( constant+  ) where++import Copilot.Core (Typed)+import Copilot.Language.Stream++--------------------------------------------------------------------------------++constant :: Typed a => a -> Stream a+constant = Const++--------------------------------------------------------------------------------
+ src/Copilot/Language/Operators/Eq.hs view
@@ -0,0 +1,28 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++-- |++module Copilot.Language.Operators.Eq+  ( (==)+  , (/=)+  ) where++import Copilot.Core (Typed, typeOf)+import qualified Copilot.Core as Core+import Copilot.Language.Prelude+import Copilot.Language.Stream+import qualified Prelude as P++--------------------------------------------------------------------------------++(==) :: (P.Eq a, Typed a) => Stream a -> Stream a -> Stream Bool+(Const x) == (Const y) = Const (x P.== y)+x == y = Op2 (Core.Eq typeOf) x y++(/=) :: (P.Eq a, Typed a) => Stream a -> Stream a -> Stream Bool+(Const x) /= (Const y) = Const (x P./= y)+x /= y = Op2 (Core.Ne typeOf) x y++--------------------------------------------------------------------------------
+ src/Copilot/Language/Operators/Extern.hs view
@@ -0,0 +1,65 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++-- |++module Copilot.Language.Operators.Extern+  ( extern+  , externW8+  , externW16+  , externW32+  , externW64+  , externI8+  , externI16+  , externI32+  , externI64+  , externF+  , externD+  , FunArg+  , externFun+  , externArray+  , funArg+  ) where++import Copilot.Core (Typed)+import Copilot.Language.Stream+import Data.Word+import Data.Int++--------------------------------------------------------------------------------++extern :: Typed a => String -> Stream a+extern = Extern++externFun :: Typed a => String -> [FunArg] -> Stream a+externFun = ExternFun++externArray :: (Typed a, Typed b, Integral a) => String -> Stream a -> Stream b+externArray = ExternArray++funArg :: Typed a => Stream a -> FunArg+funArg = FunArg++--------------------------------------------------------------------------------++externW8  :: String -> Stream Word8+externW8  = extern +externW16 :: String -> Stream Word16+externW16 = extern+externW32 :: String -> Stream Word32+externW32 = extern+externW64 :: String -> Stream Word64+externW64 = extern+externI8  :: String -> Stream Int8+externI8  = extern+externI16 :: String -> Stream Int16+externI16 = extern+externI32 :: String -> Stream Int32+externI32 = extern+externI64 :: String -> Stream Int64+externI64 = extern+externF   :: String -> Stream Float+externF   = extern+externD   :: String -> Stream Double+externD   = extern
+ src/Copilot/Language/Operators/Integral.hs view
@@ -0,0 +1,31 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++-- |++module Copilot.Language.Operators.Integral+  ( div+  , mod+  ) where++import Copilot.Core (Typed, typeOf)+import qualified Copilot.Core as Core+import Copilot.Language.Stream+import qualified Prelude as P++--------------------------------------------------------------------------------++div :: (Typed a, P.Integral a) => Stream a -> Stream a -> Stream a+(Const 0) `div` _ = Const 0+_ `div` (Const 0) = Core.badUsage "in div: division by zero"+x `div` (Const 1) = x+x `div` y = Op2 (Core.Div typeOf) x y++mod :: (Typed a, P.Integral a) => Stream a -> Stream a -> Stream a+_         `mod` (Const 0) = Core.badUsage "in mod: division by zero"+(Const 0) `mod` _         = (Const 0)+(Const x) `mod` (Const y) = Const (x `P.mod` y)+x `mod` y = Op2 (Core.Mod typeOf) x y++--------------------------------------------------------------------------------
+ src/Copilot/Language/Operators/Local.hs view
@@ -0,0 +1,19 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++-- |++module Copilot.Language.Operators.Local+  ( local+  ) where++import Copilot.Core (Typed)+import Copilot.Language.Stream (Stream (..))++--------------------------------------------------------------------------------++local :: (Typed a, Typed b) => Stream a -> (Stream a -> Stream b) -> Stream b+local = Local++--------------------------------------------------------------------------------
+ src/Copilot/Language/Operators/Mux.hs view
@@ -0,0 +1,30 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++-- |++module Copilot.Language.Operators.Mux+  ( mux+  , ifThenElse+  ) where++import Copilot.Core (Typed, typeOf)+import qualified Copilot.Core as Core+import Copilot.Language.Prelude+import Copilot.Language.Stream+import Prelude ()++--------------------------------------------------------------------------------++mux :: Typed a => Stream Bool -> Stream a -> Stream a -> Stream a+mux (Const True) t _  = t+mux (Const False) _ f = f+mux b t f             = Op3 (Core.Mux typeOf) b t f++--------------------------------------------------------------------------------++ifThenElse :: Typed a => Stream Bool -> Stream a -> Stream a -> Stream a+ifThenElse = mux++--------------------------------------------------------------------------------
+ src/Copilot/Language/Operators/Ord.hs view
@@ -0,0 +1,38 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++-- |++module Copilot.Language.Operators.Ord+  ( (<=)+  , (>=)+  , (<)+  , (>)+  ) where++import Copilot.Core (Typed, typeOf)+import qualified Copilot.Core as Core+import Copilot.Language.Prelude+import Copilot.Language.Stream+import qualified Prelude as P++--------------------------------------------------------------------------------++(<=) :: (P.Ord a, Typed a) => Stream a -> Stream a -> Stream Bool+(Const x) <= (Const y) = Const (x P.<= y)+x <= y                 = Op2 (Core.Le typeOf) x y++(>=) :: (P.Ord a, Typed a) => Stream a -> Stream a -> Stream Bool+(Const x) >= (Const y) = Const (x P.>= y)+x >= y                 = Op2 (Core.Ge typeOf) x y++(<) :: (P.Ord a, Typed a) => Stream a -> Stream a -> Stream Bool+(Const x) < (Const y) = Const (x P.< y)+x < y                 = Op2 (Core.Lt typeOf) x y++(>) :: (P.Ord a, Typed a) => Stream a -> Stream a -> Stream Bool+(Const x) > (Const y) = Const (x P.> y)+x > y                 = Op2 (Core.Gt typeOf) x y++--------------------------------------------------------------------------------
+ src/Copilot/Language/Operators/Temporal.hs view
@@ -0,0 +1,28 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++-- |++module Copilot.Language.Operators.Temporal+  ( (++)+  , drop+  ) where++import Copilot.Core (Typed)+import Copilot.Language.Prelude+import Copilot.Language.Stream+import Prelude ()++--------------------------------------------------------------------------------++infixr 1 ++++(++) :: Typed a => [a] -> Stream a -> Stream a+(++) = (`Append` Nothing)++drop :: Typed a => Int -> Stream a -> Stream a+drop 0 s             = s+drop _ ( Const j )   = Const j+drop i ( Drop  j s ) = Drop (fromIntegral i + j) s+drop i s             = Drop (fromIntegral i)     s
+ src/Copilot/Language/Prelude.hs view
@@ -0,0 +1,32 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++-- | Reexports 'Prelude' from package "base" hiding identifiers redefined by+-- Copilot.++module Copilot.Language.Prelude+  ( module Prelude+  ) where++import Prelude hiding+  ( (++)+  , (==), (/=)+  , div, mod+  , (<=), (>=), (<), (>)+  , (&&)+  , (||)+  , const+  , drop+  , not+  , mod +  , until+  , sum+  , max+  , min+  , (!!)+  , cycle+  , take +  )++--------------------------------------------------------------------------------
+ src/Copilot/Language/Reify.hs view
@@ -0,0 +1,265 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++-- | Transforms a Copilot Language specification into a Copilot Core+-- specification.++{-# LANGUAGE ExistentialQuantification, Rank2Types #-}++module Copilot.Language.Reify+  ( reify+  ) where++import Copilot.Core (Typed, Type, Id, typeOf, impossible)+import qualified Copilot.Core as Core+--import Copilot.Language.Reify.Sharing (makeSharingExplicit)+import Copilot.Language.Analyze (analyze)+import Copilot.Language.Spec+import Copilot.Language.Stream (Stream (..), FunArg (..))+import Data.IORef+import Prelude hiding (id)+import System.Mem.StableName.Dynamic+import System.Mem.StableName.Dynamic.Map (Map)+import qualified System.Mem.StableName.Dynamic.Map as M++--------------------------------------------------------------------------------++reify :: Spec -> IO Core.Spec+reify spec =+  do+    analyze spec+    let trigs = triggers  $ runSpec spec+    let obsvs = observers $ runSpec spec+    refMkId      <- newIORef 0+    refVisited    <- newIORef M.empty+    refMap        <- newIORef []+    coreTriggers  <- mapM (mkTrigger  refMkId refVisited refMap) trigs+    coreObservers <- mapM (mkObserver refMkId refVisited refMap) obsvs+    coreStreams   <- readIORef refMap+    return $+      Core.Spec+        { Core.specStreams   = reverse coreStreams+        , Core.specObservers = coreObservers+        , Core.specTriggers  = coreTriggers }++--------------------------------------------------------------------------------++{-# INLINE mkObserver #-}+mkObserver+  :: IORef Int+  -> IORef (Map Core.Id)+  -> IORef [Core.Stream]+  -> Observer+  -> IO Core.Observer+mkObserver refMkId refStreams refMap (Observer name e) =+  do +    w <- mkExpr refMkId refStreams refMap e+    return $+      Core.Observer+         { Core.observerName     = name+         , Core.observerExpr     = w+         , Core.observerExprType = typeOf }++--------------------------------------------------------------------------------++{-# INLINE mkTrigger #-}+mkTrigger+  :: IORef Int+  -> IORef (Map Core.Id)+  -> IORef [Core.Stream]+  -> Trigger+  -> IO Core.Trigger+mkTrigger refMkId refStreams refMap (Trigger name guard args) =+  do+    w1 <- mkExpr refMkId refStreams refMap guard +    args' <- mapM mkTriggerArg args+    return $+      Core.Trigger+        { Core.triggerName  = name+        , Core.triggerGuard = w1 +        , Core.triggerArgs  = args' }++  where++  mkTriggerArg :: TriggerArg -> IO Core.UExpr+  mkTriggerArg (TriggerArg e) =+    do+      w <- mkExpr refMkId refStreams refMap e+      return $ Core.UExpr typeOf w++--------------------------------------------------------------------------------++{-# INLINE mkExpr #-}+mkExpr+  :: Typed a+  => IORef Int+  -> IORef (Map Core.Id)+  -> IORef [Core.Stream]+  -> Stream a+  -> IO (Core.Expr a)+mkExpr refMkId refStreams refMap = go++--  (>>= go) . makeSharingExplicit refMkId++  where++  go+    :: Typed a+    => Stream a+    -> IO (Core.Expr a)+  go e0 =++    case e0 of++      ------------------------------------------------------++      Append _ _ _ ->++        do s <- mkStream refMkId refStreams refMap e0+           return $ Core.Drop typeOf 0 s++      ------------------------------------------------------++      Drop k e1 ->++        case e1 of+          Append _ _ _ ->+            do+              s <- mkStream refMkId refStreams refMap e1+              return $ Core.Drop typeOf (fromIntegral k) s+          _ -> impossible "mkExpr" "copilot-language"++      ------------------------------------------------------++      Const x ->++        return $ Core.Const typeOf x++      ------------------------------------------------------++      Local e f ->++        do+          id <- mkId refMkId+          let cs = "local_" ++ show id+          w1 <- go e+          w2 <- go (f (Var cs))+          return $ Core.Local typeOf typeOf cs w1 w2++      ------------------------------------------------------++      Var cs ->++        return $ Core.Var typeOf cs++      ------------------------------------------------------++      Extern cs ->++        return $ Core.ExternVar typeOf cs++      ------------------------------------------------------++      ExternFun cs args ->++        do+          args' <- mapM mkFunArg args+          return $ Core.ExternFun typeOf cs args' Nothing++      ------------------------------------------------------++      ExternArray cs e ->++        do+          w <- go e+          return $ Core.ExternArray typeOf typeOf cs w Nothing++      ------------------------------------------------------++      Op1 op e ->++        do+          w <- go e+          return $ Core.Op1 op w++      ------------------------------------------------------++      Op2 op e1 e2 ->++        do+          w1 <- go e1+          w2 <- go e2+          return $ Core.Op2 op w1 w2++      ------------------------------------------------------++      Op3 op e1 e2 e3 ->++        do+          w1 <- go e1+          w2 <- go e2+          w3 <- go e3+          return $ Core.Op3 op w1 w2 w3++      ------------------------------------------------------++  mkFunArg :: FunArg -> IO Core.UExpr+  mkFunArg (FunArg e) =+    do+      w <- mkExpr refMkId refStreams refMap e+      return $ Core.UExpr typeOf w++--------------------------------------------------------------------------------++{-# INLINE mkStream #-}+mkStream+  :: Typed a+  => IORef Int+  -> IORef (Map Core.Id)+  -> IORef [Core.Stream]+  -> Stream a+  -> IO Id+mkStream refMkId refStreams refMap e0 =+  do+    dstn <- makeDynStableName e0+    let Append buf _ e = e0 -- avoids warning+    mk <- haveVisited dstn+    case mk of+      Just id_ -> return id_+      Nothing  -> addToVisited dstn buf e++  where++  {-# INLINE haveVisited #-}+  haveVisited :: DynStableName -> IO (Maybe Int)+  haveVisited dstn =+    do+      tab <- readIORef refStreams+      return (M.lookup dstn tab)++  {-# INLINE addToVisited #-}+  addToVisited+    :: Typed a+    => DynStableName+    -> [a]+    -> Stream a+    -> IO Id+  addToVisited dstn buf e =+    do+      id <- mkId refMkId+      modifyIORef refStreams (M.insert dstn id)+      w <- mkExpr refMkId refStreams refMap e+      modifyIORef refMap $ (:)+        Core.Stream+          { Core.streamId         = id+          , Core.streamBuffer     = buf+          , Core.streamGuard      = Core.Const (typeOf :: Type Bool) True+          , Core.streamExpr       = w+          , Core.streamExprType   = typeOf }+      return id++--------------------------------------------------------------------------------++mkId :: IORef Int -> IO Id+mkId refMkId = atomicModifyIORef refMkId $ \ n -> (succ n, n)
+ src/Copilot/Language/Spec.hs view
@@ -0,0 +1,116 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}++-- |++module Copilot.Language.Spec+  ( Spec+  , runSpec+  , SpecItem+  , Observer (..)+  , observer+  , observers+  , Trigger (..)+  , TriggerArg (..)+  , triggers+  , trigger+  , arg+  ) where++import Control.Monad.Writer+import Data.List (foldl')++import Copilot.Core (Typed)+import qualified Copilot.Core as Core+import Copilot.Language.Stream++--------------------------------------------------------------------------------++type Spec = Writer [SpecItem] ()++--------------------------------------------------------------------------------++runSpec :: Spec -> [SpecItem]+runSpec = execWriter ++--------------------------------------------------------------------------------++observers :: [SpecItem] -> [Observer]+observers = +  foldl' lets' []+  where+  lets' ls e =+    case e of +      ObserverItem l -> l : ls+      _              -> ls++triggers :: [SpecItem] -> [Trigger]+triggers = +  foldl' triggers' []+  where+  triggers' ls e =+    case e of +      TriggerItem t -> t : ls+      _             -> ls++--------------------------------------------------------------------------------++data SpecItem+  = ObserverItem Observer+  | TriggerItem  Trigger++--------------------------------------------------------------------------------++data Observer where+  Observer+    :: Typed a+    => String+    -> Stream a+    -> Observer++--------------------------------------------------------------------------------++observer +  :: Typed a+  => String+  -> Stream a+  -> Spec+observer name e = tell [ObserverItem $ Observer name e]++--------------------------------------------------------------------------------++data Trigger where+  Trigger+    :: Core.Name+    -> Stream Bool+    -> [TriggerArg]+    -> Trigger++--------------------------------------------------------------------------------++data TriggerArg where+  TriggerArg+    :: Typed a+    => Stream a+    -> TriggerArg++--------------------------------------------------------------------------------++trigger+  :: String+  -> Stream Bool+  -> [TriggerArg]+  -> Spec+trigger name e args = tell [TriggerItem $ Trigger name e args]++--------------------------------------------------------------------------------++arg :: Typed a => Stream a -> TriggerArg+arg = TriggerArg++--------------------------------------------------------------------------------
+ src/Copilot/Language/Stream.hs view
@@ -0,0 +1,160 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++-- |++{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE Rank2Types #-}++module Copilot.Language.Stream+  ( Stream (..)+  , FunArg (..)+  ) where++import Copilot.Core (Typed, typeOf)+import Copilot.Core.Error+import qualified Copilot.Core as Core+import Copilot.Language.Prelude+import qualified Prelude as P++--------------------------------------------------------------------------------++data Stream :: * -> * where+  Append+    :: Typed a+    => [a]+    -> Maybe (Stream Bool)+    -> Stream a+    -> Stream a+  Const+    :: Typed a+    => a+    -> Stream a+  Drop+    :: Typed a+    => Int+    -> Stream a+    -> Stream a+  Extern+    :: Typed a+    => String+    -> Stream a+  ExternFun+    :: Typed a+    => String+    -> [FunArg]+    -> Stream a+  ExternArray+    :: (Typed a, Typed b, Integral a)+    => String+    -> Stream a+    -> Stream b+  Local+    :: (Typed a, Typed b)+    => Stream a+    -> (Stream a -> Stream b)+    -> Stream b+  Var+    :: Typed a+    => String+    -> Stream a+  Op1+    :: (Typed a, Typed b)+    => Core.Op1 a b+    -> Stream a -> Stream b+  Op2+    :: (Typed a, Typed b, Typed c)+    => Core.Op2 a b c+    -> Stream a -> Stream b -> Stream c+  Op3+    :: (Typed a, Typed b, Typed c, Typed d)+    => Core.Op3 a b c d+    -> Stream a+    -> Stream b+    -> Stream c+    -> Stream d++--------------------------------------------------------------------------------++data FunArg where+  FunArg :: Typed a => Stream a -> FunArg++--------------------------------------------------------------------------------++-- | Dummy instance in order to make 'Stream' an instance of 'Num'.+instance Show (Stream a) where+  show _      = "Stream"++--------------------------------------------------------------------------------++-- | Dummy instance in order to make 'Stream' an instance of 'Num'.+instance P.Eq (Stream a) where+  (==)        = badUsage "'Prelude.(==)' isn't implemented for streams!"+  (/=)        = badUsage "'Prelude.(/=)' isn't implemented for streams!"++--------------------------------------------------------------------------------++instance (Typed a, Num a) => Num (Stream a) where+  (Const x) + (Const y)   = Const (x + y)+  (Const 0) + y           = y+  x + (Const 0)           = x+  x + y                   = Op2 (Core.Add typeOf) x y++  (Const x) - (Const y)   = Const (x - y)+  x - (Const 0)           = x+  x - y                   = Op2 (Core.Sub typeOf) x y++  (Const x) * (Const y)   = Const (x * y)+  (Const 0) * _           = Const 0+  _ * (Const 0)           = Const 0+  (Const 1) * y           = y+  x * (Const 1)           = x+  x * y                   = Op2 (Core.Mul typeOf) x y++  abs (Const x)           = Const (abs x)+  abs x                   = Op1 (Core.Abs typeOf) x++  signum (Const x)        = Const (signum x)+  signum x                = Op1 (Core.Sign typeOf) x++  fromInteger             = Const . fromInteger++--------------------------------------------------------------------------------++-- XXX we may not want to precompute these if they're constants if someone is+-- relying on certain floating-point behavior.+instance (Typed a, Fractional a) => Fractional (Stream a) where+  (/)                     = Op2 (Core.Fdiv typeOf) ++  recip (Const x)         = Const (recip x)+  recip x                 = Op1 (Core.Recip typeOf) x++  fromRational            = Const . fromRational++--------------------------------------------------------------------------------++-- XXX we may not want to precompute these if they're constants if someone is+-- relying on certain floating-point behavior.+instance (Typed a, Floating a) => Floating (Stream a) where+  pi           = Const pi+  exp          = Op1 (Core.Exp typeOf)+  sqrt         = Op1 (Core.Sqrt typeOf)+  log          = Op1 (Core.Log typeOf)+  (**)         = Op2 (Core.Pow typeOf)+  logBase      = Op2 (Core.Logb typeOf)+  sin          = Op1 (Core.Sin typeOf)+  tan          = Op1 (Core.Tan typeOf)+  cos          = Op1 (Core.Cos typeOf)+  asin         = Op1 (Core.Asin typeOf)+  atan         = Op1 (Core.Atan typeOf)+  acos         = Op1 (Core.Acos typeOf)+  sinh         = Op1 (Core.Sinh typeOf)+  tanh         = Op1 (Core.Tanh typeOf)+  cosh         = Op1 (Core.Cosh typeOf)+  asinh        = Op1 (Core.Asinh typeOf)+  atanh        = Op1 (Core.Atanh typeOf)+  acosh        = Op1 (Core.Acosh typeOf)++--------------------------------------------------------------------------------
+ src/System/Mem/StableName/Dynamic.hs view
@@ -0,0 +1,26 @@+--------------------------------------------------------------------------------+-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.+--------------------------------------------------------------------------------++module System.Mem.StableName.Dynamic+  ( DynStableName(..)+  , hashDynStableName+  , makeDynStableName+  ) where++import System.Mem.StableName (StableName, makeStableName, hashStableName)+import Unsafe.Coerce (unsafeCoerce)++newtype DynStableName = DynStableName (StableName ())++makeDynStableName :: a -> IO DynStableName+makeDynStableName x =+  do+    stn <- makeStableName x+    return (DynStableName (unsafeCoerce stn))++hashDynStableName :: DynStableName -> Int+hashDynStableName (DynStableName sn) = hashStableName sn++instance Eq DynStableName where+  DynStableName sn1 == DynStableName sn2 = sn1 == sn2
+ src/System/Mem/StableName/Dynamic/Map.hs view
@@ -0,0 +1,90 @@+--------------------------------------------------------------------------------+-- Most of this code is taken from 'http://github.com/ekmett/stable-maps'.+--------------------------------------------------------------------------------++module System.Mem.StableName.Dynamic.Map+    ( Map+    , empty+    , null+    , singleton+    , member+    , notMember+    , insert+    , insertWith+    , insertWith'+    , lookup+    , find+    , findWithDefault+    ) where++import qualified Prelude+import Prelude hiding (lookup, null)+import System.Mem.StableName.Dynamic+import qualified Data.IntMap as IntMap+import Data.IntMap (IntMap)++import Copilot.Core.Error (impossible)++newtype Map a = Map { getMap :: IntMap [(DynStableName, a)] } ++empty :: Map a+empty = Map IntMap.empty++null :: Map a -> Bool+null (Map m) = IntMap.null m++singleton :: DynStableName -> a -> Map a+singleton k v = Map $ IntMap.singleton (hashDynStableName k) [(k,v)]++member :: DynStableName -> Map a -> Bool+member k m = case lookup k m of+    Nothing -> False+    Just _ -> True++notMember :: DynStableName -> Map a -> Bool+notMember k m = not $ member k m ++insert :: DynStableName -> a -> Map a -> Map a+insert k v = Map . IntMap.insertWith (++) (hashDynStableName k) [(k,v)] . getMap+    +-- | /O(log n)/. Insert with a function for combining the new value and old value.+-- @'insertWith' f key value mp@+-- will insert the pair (key, value) into @mp@ if the key does not exist+-- in the map. If the key does exist, the function will insert the pair+-- @(key, f new_value old_value)@+insertWith :: (a -> a -> a) -> DynStableName -> a -> Map a -> Map a+insertWith f k v = Map . IntMap.insertWith go (hashDynStableName k) [(k,v)] . getMap +    where +        go _ ((k',v'):kvs) +            | k == k' = (k', f v v') : kvs+            | otherwise = (k',v') : go undefined kvs+        go _ [] = []++-- | Same as 'insertWith', but with the combining function applied strictly.+insertWith' :: (a -> a -> a) -> DynStableName -> a -> Map a -> Map a+insertWith' f k v = Map . IntMap.insertWith go (hashDynStableName k) [(k,v)] . getMap +    where +        go _ ((k',v'):kvs) +            | k == k' = let v'' = f v v' in v'' `seq` (k', v'') : kvs+            | otherwise = (k', v') : go undefined kvs+        go _ [] = []++-- | /O(log n)/. Lookup the value at a key in the map.+-- +-- The function will return the corresponding value as a @('Just' value)@+-- or 'Nothing' if the key isn't in the map.+lookup :: DynStableName -> Map v -> Maybe v+lookup k (Map m) = do+    pairs <- IntMap.lookup (hashDynStableName k) m+    Prelude.lookup k pairs++find :: DynStableName -> Map v -> v+find k m = case lookup k m of+    Nothing -> impossible "find" "copilot-language"+    Just x -> x ++-- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns+-- the value at key @k@ or returns the default value @def@+-- when the key is not in the map.+findWithDefault :: v -> DynStableName -> Map v -> v+findWithDefault dflt k m = maybe dflt id $ lookup k m