ddc-base 0.4.1.3 → 0.4.2.1

raw patch · 9 files changed

+274/−14 lines, 9 filesdep ~basedep ~containersdep ~deepseqPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, containers, deepseq, wl-pprint

API changes (from Hackage documentation)

Files

• DDC/Base/Env.hs +174/−0
• DDC/Base/Name.hs +22/−0
• DDC/Base/Panic.hs +23/−0
• DDC/Base/Parser.hs +11/−3
• DDC/Base/Pretty.hs +10/−0
• DDC/Control/Monad/Check.hs +0/−1
• DDC/Data/ListUtils.hs +13/−2
• DDC/Version.hs +8/−0
• ddc-base.cabal +13/−8

@@ -0,0 +1,174 @@++-- | Generic environment that handles both named and anonymous+--   de-bruijn binders.+module DDC.Base.Env+        ( -- * Types+          Bind   (..)+        , Bound  (..)+        , Env    (..)++          -- * Conversion+        , fromList+        , fromNameList+        , fromNameMap++          -- * Constructors+        , empty+        , singleton+        , extend,       extends+        , union,        unions++          -- * Lookup+        , member+        , lookup+        , lookupName,   lookupIx+        , depth)+where+import Data.Maybe+import Data.Map                         (Map)+import qualified Data.Map.Strict        as Map+import qualified Prelude                as P+import Prelude                          hiding (lookup)+++-------------------------------------------------------------------------------+-- | A binding occurrence of a variable.+data Bind n+        -- | No binding, or alternatively, bind a fresh name that has+        --   no bound uses.+        = BNone++        -- | Anonymous binder.+        | BAnon++        -- | Named binder.+        | BName !n+        deriving (Eq, Ord, Show)+++-- | A bound occurrence of a variable.+data Bound n+        -- | Index an anonymous binder.+        = UIx   !Int++        -- | Named variable.+        | UName !n+        deriving (Eq, Ord, Show)+++-- | Generic environment that maps a variable to a thing of type @a@. +data Env n a+        = Env+        { -- | Named things.+          envMap         :: !(Map n a)++          -- | Anonymous things.+        , envStack       :: ![a] +        +          -- | Length of the stack.+        , envStackLength :: !Int }+++-------------------------------------------------------------------------------+-- | Convert a list of `Bind`s to an environment.+fromList :: Ord n => [(Bind n, a)] -> Env n a+fromList bs+        = foldr (uncurry extend) empty bs+++-- | Convert a list of `Bind`s to an environment.+fromNameList :: Ord n => [(n, a)] -> Env n a+fromNameList bs+        = foldr (uncurry extend) empty +        $ [(BName n, x) | (n, x) <- bs ]+++-- | Convert a map of things to an environment.+fromNameMap :: Map n a -> Env n a+fromNameMap m+        = empty { envMap = m }+++---------------------------------------------------------------------------------+-- | An empty environment, with nothing in it.+empty :: Env n a+empty   = Env+        { envMap         = Map.empty+        , envStack       = [] +        , envStackLength = 0 }+++-- | Construct a singleton environment.+singleton :: Ord n => Bind n -> a -> Env n a+singleton b x+        = extend b x empty+++-- | Extend an environment with a new binding.+--   Replaces bindings with the same name already in the environment.+extend :: Ord n => Bind n -> a -> Env n a -> Env n a+extend bb x env+ = case bb of+         BNone{}        -> env++         BAnon          -> env { envStack       = x : envStack env +                               , envStackLength = envStackLength env + 1 }++         BName n        -> env { envMap         = Map.insert n x (envMap env) }+++-- | Extend an environment with a list of new bindings.+--   Replaces bindings with the same name already in the environment.+extends :: Ord n => [(Bind n, a)] -> Env n a -> Env n a+extends bs env+        = foldl (flip (uncurry extend)) env bs+++-- | Combine two environments.+--   If both environments have a binding with the same name,+--   then the one in the second environment takes preference.+union :: Ord n => Env n a -> Env n a -> Env n a+union env1 env2+        = Env  +        { envMap         = envMap env1 `Map.union` envMap env2+        , envStack       = envStack       env2  ++ envStack       env1+        , envStackLength = envStackLength env2  +  envStackLength env1 }+++-- | Combine multiple environments,+--   with the latter ones taking preference.+unions :: Ord n => [Env n a] -> Env n a+unions envs+        = foldr union empty envs+++-- | Check whether a bound variable is present in an environment.+member :: Ord n => Bound n -> Env n a -> Bool+member uu env+        = isJust $ lookup uu env+++-- | Lookup a bound variable from an environment.+lookup :: Ord n => Bound n -> Env n a -> Maybe a+lookup uu env+ = case uu of+        UIx i           -> P.lookup i (zip [0..] (envStack env))+        UName n         -> Map.lookup n (envMap env) +++-- | Lookup a value from the environment based on its name.+lookupName :: Ord n => n -> Env n a -> Maybe a+lookupName n env+        = Map.lookup n (envMap env)+++-- | Lookup a value from the environment based on its index.+lookupIx :: Ord n => Int -> Env n a -> Maybe a+lookupIx ix env+        = P.lookup ix (zip [0..] (envStack env))+++-- | Yield the total depth of the anonymous stack.+depth :: Env n a -> Int+depth env       = envStackLength env+

@@ -0,0 +1,22 @@++module DDC.Base.Name+        ( StringName   (..)+        , CompoundName (..))+where++class StringName n where+        -- | Produce a flat string from a name.+        --   The resulting string should be re-lexable as a bindable name.+        stringName      :: n -> String+++-- | Compound names can be extended to create new names.+--   This is useful when generating fresh names during program transformation.+class CompoundName n where+        -- | Build a new name based on the given one.+        extendName      :: n -> String -> n+        +        -- | Split the extension string from a name.+        splitName       :: n -> Maybe (n, String)++

@@ -0,0 +1,23 @@++module DDC.Base.Panic+        (panic)+where+import DDC.Base.Pretty+++-- | Print an error message and exit the compiler, ungracefully.+--+--   This function should be called when we end up in a state that is definately+--   due to a bug in the compiler. +--+panic   :: String       -- ^ Package name,+        -> String       -- ^ Function name.+        -> Doc          -- ^ Error message that makes some suggestion of what+                        --   caused the error.+        -> a++panic pkg fun msg+        = error $ renderIndent $ vcat+        [ text "PANIC in" <+> text pkg <> text "." <> text fun +        , indent 2 msg +        , empty]

@@ -5,7 +5,7 @@         ( module Text.Parsec         , Parser         , ParserState   (..)-        , D.SourcePos+        , D.SourcePos   (..)         , runTokenParser         , pTokMaybe,    pTokMaybeSP         , pTokAs,       pTokAsSP@@ -34,7 +34,7 @@         , stateFileName         :: String }  --- | Run a generic parser.+-- | Run a generic parser, making sure all input is consumed. runTokenParser         :: Eq k         => (k -> String)        -- ^ Show a token.@@ -44,11 +44,19 @@         -> Either P.ParseError a  runTokenParser tokenShow fileName parser - = P.runParser parser+ = P.runParser eofParser         ParseState          { stateTokenShow        = tokenShow         , stateFileName         = fileName }         fileName+ where+  eofParser+   = do r <- parser+        -- We can't use primitive Text.Parsec.eof because it requires+        -- @Show (Token k)@+        (do+                c <- pTokMaybe Just+                unexpected (tokenShow c)) <|> return r   -------------------------------------------------------------------------------

@@ -8,6 +8,7 @@         ( module Text.PrettyPrint.Leijen         , Pretty(..)         , pprParen+        , padL          -- * Rendering         , RenderMode (..)@@ -71,6 +72,15 @@  instance (Pretty a, Pretty b) => Pretty (a, b) where  ppr (a, b) = parens $ ppr a <> comma <> ppr b+++padL :: Int -> Doc -> Doc+padL n d+ = let  len     = length $ renderPlain d+        pad     = n - len+   in   if pad > 0+         then  d <> text (replicate pad ' ')+         else  d   -- Rendering ------------------------------------------------------------------

@@ -8,7 +8,6 @@         , get         , put) where-import Control.Applicative import Control.Monad  

@@ -8,8 +8,10 @@         , takeInit         , takeMaximum         , index-        , findDuplicates)+        , findDuplicates+        , stripSuffix) where+import Data.List import qualified Data.Set as Set  @@ -54,7 +56,7 @@   --- | Fine the duplicate values in a list.+-- | Find the duplicate values in a list. findDuplicates :: Ord n => [n] -> [n] findDuplicates xx  = go (Set.fromList xx) xx@@ -62,3 +64,12 @@         go ss (x : xs)          | Set.member x ss  =     go (Set.delete x ss) xs          | otherwise        = x : go ss xs+++-- | Drops the given suffix from a list.+stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]+stripSuffix suff xx+ = case stripPrefix (reverse suff) (reverse xx) of+        Nothing -> Nothing+        Just xs -> Just $ reverse xs+

@@ -0,0 +1,8 @@++module DDC.Version where++splash  :: String+splash  = "The Disciplined Disciple Compiler, version " ++ version++version :: String+version = "0.4.2"

@@ -1,5 +1,5 @@ Name:           ddc-base-Version:        0.4.1.3+Version:        0.4.2.1 License:        MIT License-file:   LICENSE Author:         The Disciplined Disciple Compiler Strike Force@@ -17,23 +17,28 @@  Library   Build-Depends: -        base            >= 4.6 && < 4.8,-        deepseq         == 1.3.*,-        transformers    == 0.4.*,-        containers      == 0.5.*,-        wl-pprint       == 1.1.*,-        parsec          == 3.1.*+        base            >= 4.8   && < 4.9,+        deepseq         >= 1.4   && < 1.5,+        transformers    >= 0.4   && < 0.5,+        containers      >= 0.5.6 && < 0.6,+        wl-pprint       >= 1.1   && < 1.3,+        parsec          >= 3.1   && < 3.2            Exposed-modules:+        DDC.Base.Env+        DDC.Base.Name+        DDC.Base.Panic         DDC.Base.Parser         DDC.Base.Pretty          DDC.Control.Monad.Check          DDC.Data.Canned+        DDC.Data.ListUtils         DDC.Data.SourcePos         DDC.Data.Token-        DDC.Data.ListUtils++        DDC.Version            GHC-options:         -Wall