copilot-core 3.0 → 3.0.1

raw patch · 4 files changed

+51/−26 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• copilot-core.cabal +1/−1
• src/Copilot/Core/Interpret/Eval.hs +3/−0
• src/Copilot/Core/Interpret/Render.hs +43/−23
• src/Copilot/Core/Operators.hs +4/−2

@@ -1,6 +1,6 @@ cabal-version:       >=1.10 name:                copilot-core-version:             3.0+version:             3.0.1 synopsis:            An intermediate representation for Copilot. description:   Intermediate representation for Copilot.

@@ -251,6 +251,8 @@   Acosh _    -> P.acosh   BwNot _    -> complement   Cast _ _   -> P.fromIntegral+  GetField (Struct _) _ f -> unfield . f where+    unfield (Field v) = v  -------------------------------------------------------------------------------- @@ -277,6 +279,7 @@   BwXor _      -> (xor)   BwShiftL _ _ -> ( \ !a !b -> shiftL a $! fromIntegral b )   BwShiftR _ _ -> ( \ !a !b -> shiftR a $! fromIntegral b )+  Index    _   -> \xs n -> (arrayelems xs) !! (fromIntegral n)  catchZero :: Integral a => (a -> a -> a) -> (a -> a -> a) catchZero _ _ 0 = throw DivideByZero

@@ -15,9 +15,7 @@ import Data.Maybe (catMaybes) import Copilot.Core.Interpret.Eval (Output, ExecTrace (..)) import qualified Data.Map as M--- TODO: pretty-ncols is not updated yet to support >=base-4.11--- import Text.PrettyPrint.NCol (asColumns)-import Text.PrettyPrint (Doc, ($$), (<>), text, render, empty)+import Text.PrettyPrint  import Prelude hiding ((<>)) @@ -27,31 +25,29 @@ renderAsTable   ExecTrace     { interpTriggers  = trigs-    , interpObservers = obsvs } = "Rendering as table is not support, because pretty-ncols is not updated (yet) to newer base versions."-  -- ( render-  -- . asColumns-  -- . transpose-  -- . (:) (ppTriggerNames ++ ppObserverNames)-  -- . transpose-  -- ) (ppTriggerOutputs ++ ppObserverOutputs)--  -- where+    , interpObservers = obsvs } = ( render+                                  . asColumns+                                  . transpose+                                  . (:) (ppTriggerNames ++ ppObserverNames)+                                  . transpose+                                  ) (ppTriggerOutputs ++ ppObserverOutputs)+     where -  -- ppTriggerNames :: [Doc]-  -- ppTriggerNames  = map (text . (++ ":")) (M.keys trigs)+     ppTriggerNames :: [Doc]+     ppTriggerNames  = map (text . (++ ":")) (M.keys trigs) -  -- ppObserverNames :: [Doc]-  -- ppObserverNames = map (text . (++ ":")) (M.keys obsvs)+     ppObserverNames :: [Doc]+     ppObserverNames = map (text . (++ ":")) (M.keys obsvs) -  -- ppTriggerOutputs :: [[Doc]]-  -- ppTriggerOutputs = map (map ppTriggerOutput) (M.elems trigs)+     ppTriggerOutputs :: [[Doc]]+     ppTriggerOutputs = map (map ppTriggerOutput) (M.elems trigs) -  -- ppTriggerOutput :: Maybe [Output] -> Doc-  -- ppTriggerOutput (Just vs) = text $ "(" ++ concat (intersperse "," vs) ++ ")"-  -- ppTriggerOutput Nothing   = text "--"+     ppTriggerOutput :: Maybe [Output] -> Doc+     ppTriggerOutput (Just vs) = text $ "(" ++ concat (intersperse "," vs) ++ ")"+     ppTriggerOutput Nothing   = text "--" -  -- ppObserverOutputs :: [[Doc]]-  -- ppObserverOutputs = map (map text) (M.elems obsvs)+     ppObserverOutputs :: [[Doc]]+     ppObserverOutputs = map (map text) (M.elems obsvs)  -------------------------------------------------------------------------------- @@ -98,3 +94,27 @@           }  --------------------------------------------------------------------------------++++-- Copied from pretty-ncols because of incompatibility with newer GHC versions.+asColumns :: [[Doc]] -> Doc+asColumns = flip asColumnsWithBuff $ 1++asColumnsWithBuff :: [[Doc]] -> Int -> Doc+asColumnsWithBuff lls q = normalize+        where normalize = vcat $ map hsep +                        $ map (\x -> pad (length x) longColumnLen empty x) +                        $ pad' longEntryLen q+                        $ transpose lls -- normalize column height+              longColumnLen = maximum (map length lls)+              longEntryLen = maximum $ map docLen (concat lls)++docLen d = length $ render d ++pad :: Int -> Int -> a -> [a] -> [a]+pad lx max b ls = ls ++ replicate (max - lx) b++pad' _ _ []       = []+pad' mx q (ls:xs) = map buf ls : pad' mx q xs +        where buf x = x <> (hcat $ replicate q space) <> (hcat $ replicate (mx - (docLen x)) space)

@@ -11,7 +11,9 @@   , Op3 (..)   ) where -import Copilot.Core.Type        (Type(..))+import GHC.TypeLits             (KnownSymbol)++import Copilot.Core.Type        (Type(..), Field(..)) import Copilot.Core.Type.Array  (Array) import Data.Bits import Data.Word                (Word32)@@ -48,7 +50,7 @@   -- Casting operator.   Cast     :: (Integral a, Num b) => Type a -> Type b -> Op1 a b   -- Struct operator.-  GetField :: Type a -> Type b -> String -> Op1 a b+  GetField :: KnownSymbol s => Type a -> Type b -> (a -> Field s b) -> Op1 a b  -- | Binary operators. data Op2 a b c where