express 1.0.8 → 1.0.10

raw patch · 9 files changed

+140/−8 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• .github/workflows/build.yml +3/−2
• Makefile +1/−1
• changelog.md +12/−0
• express.cabal +2/−2
• src/Data/Express/Core.hs +9/−0
• src/Data/Express/Fixtures.hs +77/−2
• stack.yaml +1/−1
• test/fixtures.hs +9/−0
• test/show.hs +26/−0

@@ -111,8 +111,8 @@     steps:       - name: Setup Haskell's GHC and Cabal as required by current Stackage LTS         uses: haskell/actions/setup@v1-        with: # lts-17.9-          ghc-version: '8.10.4'+        with: # lts-18.14+          ghc-version: '8.10.7'           cabal-version: '3.2'        - uses: actions/cache@v2@@ -131,6 +131,7 @@     runs-on: ubuntu-latest     needs: build-and-test     steps:+      - run: sudo apt-get update       - run: sudo apt-get install hugs       - name: Check out repository         uses: actions/checkout@v2

@@ -36,7 +36,7 @@   bench/tiers \   $(EGS) GHCIMPORTDIRS = src:test-GHCFLAGS = -O2 $(shell grep -q "Arch Linux" /etc/lsb-release && echo -dynamic)+GHCFLAGS = -O2 -v0 $(shell grep -q "Arch Linux" /etc/lsb-release && echo -dynamic) HUGSIMPORTDIRS = .:./src:./test:./etc/hugs-backports:/usr/lib/hugs/packages/*:../leancheck/src HUGSFLAGS = -98 -h32M RUNPARAMETERS =

@@ -2,6 +2,18 @@ =====================  +v1.0.10+-------++* show function-encoded Ordering case expressions exceptionally++* show function-encoded Bool case expressions exceptionally++* add `caseBool` and `caseOrdering` to `Data.Express.Fixtures`++* minor updates in Makefile and CI scripts++ v1.0.8 ------ 

@@ -1,6 +1,6 @@ -- Cabal file for express name: express-version: 1.0.8+version: 1.0.10 synopsis: Dynamically-typed expressions involving function application and variables. description:   Express is a library for manipulating dynamically typed Haskell expressions.@@ -63,7 +63,7 @@ source-repository this   type:           git   location:       https://github.com/rudymatela/express-  tag:            v1.0.8+  tag:            v1.0.10  library   exposed-modules:     Data.Express

@@ -471,6 +471,15 @@   showParen (d >= 0) $ showString "if "    . showsPrecExpr 0 ep                      . showString " then " . showsPrecExpr 0 ex                      . showString " else " . showsPrecExpr 0 ey+showsPrecExpr d (Value "case" _ :$ ep :$ ex :$ ey) | typ ep == boolTy =+  showParen (d >= 0) $ showString "case "         . showsPrecExpr 0 ep+                     . showString " of False -> " . showsPrecExpr 0 ex+                     . showString "; True -> "    . showsPrecExpr 0 ey+showsPrecExpr d (Value "case" _ :$ eo :$ ex :$ ey :$ ez) | typ eo == orderingTy =+  showParen (d >= 0) $ showString "case "      . showsPrecExpr 0 eo+                     . showString " of LT -> " . showsPrecExpr 0 ex+                     . showString "; EQ -> "   . showsPrecExpr 0 ey+                     . showString "; GT -> "   . showsPrecExpr 0 ez showsPrecExpr d (Value ",.." _ :$ ex :$ ey :$ ez) =   showString "[" . showsPrecExpr 0 ex                  . showString (if dotdot ex && dotdot ey && dotdot ez then "," else ", ")

@@ -111,6 +111,8 @@   , (-<-)   , compare'   , if'+  , caseBool+  , caseOrdering    -- ** Integers   , i_, xx, yy, zz, xx'@@ -1472,8 +1474,9 @@   err  =  error $ "(-<-): unhandled type " ++ show (typ ex) infix 4 -<- --- | A virtual function @if :: Bool -> a -> a -> a@ lifted over the 'Expr' type.---   This is displayed as an if-then-else.+-- | A function @if :: Bool -> a -> a -> a@ lifted over the 'Expr' type+--   that encodes if-then-else functionality.+--   This is properly displayed as an if-then-else. -- -- > > if' pp zero xx -- > (if p then 0 else x) :: Int@@ -1501,6 +1504,78 @@   iff :: Bool -> a -> a -> a   iff p x y  =  if p then x else y type If a = Bool -> a -> a -> a++-- | A function @case :: Bool -> a -> a -> a@ lifted over the 'Expr' type+--   that encodes case-of-False-True functionality.+--   This is properly displayed as a case-of-False-True expression.+--+-- > > caseBool pp zero xx+-- > (case p of False -> 0; True -> x) :: Int+--+-- > > zz -*- caseBool pp xx yy+-- > z * (case p of False -> x; True -> y) :: Int+--+-- > > caseBool pp false true -||- caseBool qq true false+-- > (caseBool p of False -> False; True -> True) || (caseBool q of False -> True; True -> False) :: Bool+--+-- > > evl $ caseBool true (val 'f') (val 't') :: Char+-- > 't'+--+-- By convention, the 'False' case comes before 'True'+-- as @False < True@ and @data Bool = False | True@.+--+-- When evaluating, this is equivalent to if with arguments reversed.+-- Instead of using this, you are perhaps better of using if encoded as an+-- expression.  This is just here to be consistent with 'caseOrdering'.+caseBool :: Expr -> Expr -> Expr -> Expr+caseBool ep ex ey  =  (:$ ey) . headOr err . mapMaybe ($$ ex) $ map (:$ ep)+  [ value "case" (caseB :: CaseB ())+  , value "case" (caseB :: CaseB Int)+  , value "case" (caseB :: CaseB Bool)+  , value "case" (caseB :: CaseB Char)+  , value "case" (caseB :: CaseB [Int])+  , value "case" (caseB :: CaseB [Bool])+  , value "case" (caseB :: CaseB [Char])+  ]+  where+  err  =  error $ "caseBool: unhandled type " ++ show (typ ex)+  caseB :: Bool -> a -> a -> a+  caseB p x y  =  case p of+                  False -> x+                  True -> y+type CaseB a = Bool -> a -> a -> a++-- | A function @case :: Ordering -> a -> a -> a -> a@ lifted over the 'Expr' type+--   that encodes case-of-LT-EQ-GT functionality.+--   This is properly displayed as a case-of-LT-EQ-GT expression.+--   (cf. 'caseBool')+--+-- > > caseOrdering (xx `compare'` yy) zero one two+-- > (case compare x y of LT -> 0; EQ -> 1; GT -> 2) :: Int+--+-- > > evl $ caseOrdering (val EQ) (val 'l') (val 'e') (val 'g') :: Char+-- > 'e'+--+-- By convention cases are given in 'LT', 'EQ' and 'GT' order+-- as @LT < EQ < GT@ and @data Ordering = LT | EQ | GT@.+caseOrdering :: Expr -> Expr -> Expr -> Expr -> Expr+caseOrdering eo ex ey ez  =  (:$ ez) . (:$ ey) . headOr err . mapMaybe ($$ ex) $ map (:$ eo)+  [ value "case" (caseO :: CaseO ())+  , value "case" (caseO :: CaseO Int)+  , value "case" (caseO :: CaseO Bool)+  , value "case" (caseO :: CaseO Char)+  , value "case" (caseO :: CaseO [Int])+  , value "case" (caseO :: CaseO [Bool])+  , value "case" (caseO :: CaseO [Char])+  ]+  where+  err  =  error $ "caseOrdering: unhandled type " ++ show (typ ex)+  caseO :: Ordering -> a -> a -> a -> a+  caseO o x y z  =  case o of+                    LT -> x+                    EQ -> y+                    GT -> z+type CaseO a = Ordering -> a -> a -> a -> a  -- | Constructs an 'Expr'-encoded 'compare' operation between two 'Expr's. --

@@ -1,4 +1,4 @@-resolver: lts-17.9 # or ghc-8.10.4+resolver: lts-18.14 # or ghc-8.10.7  packages: - .

@@ -185,6 +185,15 @@   , evl (if' false zero one) == (1 :: Int)   , evl (if' true two three) == (2 :: Int) +  -- caseBool --+  , evl (caseBool false zero one) == (0 :: Int)+  , evl (caseBool true two three) == (3 :: Int)++  -- caseOrdering --+  , evl (caseOrdering (val LT) zero one two) == (0 :: Int)+  , evl (caseOrdering (val EQ) three four five) == (4 :: Int)+  , evl (caseOrdering (val GT) six seven eight) == (8 :: Int)+   -- enumFrom and enumFromTo   , show (enumFrom' false) == "enumFrom False :: [Bool]"   , evl  (enumFrom' false) == [False,True]

@@ -86,11 +86,37 @@     == "(if p then False else True) || (if q then True else False) :: Bool"   , show (if' (null' xxs) zero (head' xxs -+- value "sum" (sum :: [Int] -> Int) :$ tail' xxs))     == "(if null xs then 0 else head xs + sum (tail xs)) :: Int"+  , show (if' (xx -<- yy) (ff xx) (yy -*- zz)) == "(if x < y then f x else y * z) :: Int" +  , show (caseBool pp xx yy)             == "(case p of False -> x; True -> y) :: Int"+  , show (caseBool false zero one)       == "(case False of False -> 0; True -> 1) :: Int"+  , show (caseBool true two three)       == "(case True of False -> 2; True -> 3) :: Int"+  , show (caseBool pp false true)        == "(case p of False -> False; True -> True) :: Bool"+  , show (not' (caseBool pp false true)) == "not (case p of False -> False; True -> True) :: Bool"+  , show (caseBool pp xx yy -*- zz)      == "(case p of False -> x; True -> y) * z :: Int"+  , show (zz -*- caseBool pp xx yy)      == "z * (case p of False -> x; True -> y) :: Int"+   , showExpr (if' pp xx yy)             == "if p then x else y"   , showExpr (if' false zero one)       == "if False then 0 else 1"   , showExpr (if' true two three)       == "if True then 2 else 3"   , showExpr (if' pp false true)        == "if p then False else True"+  , showExpr (if' (xx -<- yy) (ff xx) (yy -*- zz)) == "if x < y then f x else y * z"++  , showExpr (caseBool pp xx yy)             == "case p of False -> x; True -> y"+  , showExpr (caseBool false zero one)       == "case False of False -> 0; True -> 1"+  , showExpr (caseBool true two three)       == "case True of False -> 2; True -> 3"+  , showExpr (caseBool pp false true)        == "case p of False -> False; True -> True"+  , showExpr (caseBool pp true false)        == "case p of False -> True; True -> False"++  , show (caseOrdering (compare' xx yy) xx zz yy) == "(case compare x y of LT -> x; EQ -> z; GT -> y) :: Int"+  , show (caseOrdering (val LT) zero one two)     == "(case LT of LT -> 0; EQ -> 1; GT -> 2) :: Int"+  , show (caseOrdering (val GT) three four five)  == "(case GT of LT -> 3; EQ -> 4; GT -> 5) :: Int"+  , show (caseOrdering (compare' xx yy) (ff xx) zz (yy -+- zz)) == "(case compare x y of LT -> f x; EQ -> z; GT -> y + z) :: Int"++  , showExpr (caseOrdering (compare' xx yy) xx zz yy) == "case compare x y of LT -> x; EQ -> z; GT -> y"+  , showExpr (caseOrdering (val LT) zero one two)     == "case LT of LT -> 0; EQ -> 1; GT -> 2"+  , showExpr (caseOrdering (val GT) three four five)  == "case GT of LT -> 3; EQ -> 4; GT -> 5"+  , showExpr (caseOrdering (compare' xx yy) (ff xx) zz (yy -+- zz)) == "case compare x y of LT -> f x; EQ -> z; GT -> y + z"    -- showing holes --   , show (hole (undefined :: Int -> Int) :$ one)              == "_ 1 :: Int"