diff --git a/TODO.md b/TODO.md --- a/TODO.md +++ b/TODO.md @@ -3,6 +3,8 @@ Here is a list of things TO DO for express: +* add partial application functions `-+`, `-:`, `-==` to fixtures + * document and test the `Instances` module * review Haddock of `Data.Express` diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -2,6 +2,17 @@ ===================== +v0.1.14 +------- + +* permit and pretty-print `[..]` notations. + +* improve default variable names when canonicalizing + - lists are named xs, ys, xss, yss, etc. + - functions are named f, g, h + - before they were simply x, y, z + + v0.1.12 ------- diff --git a/express.cabal b/express.cabal --- a/express.cabal +++ b/express.cabal @@ -1,6 +1,6 @@ -- Cabal file for express name: express -version: 0.1.12 +version: 0.1.14 synopsis: Dynamically-typed expressions involving applications and variables. description: Express is a library for manipulating dynamically typed Haskell expressions. @@ -61,7 +61,7 @@ source-repository this type: git location: https://github.com/rudymatela/express - tag: v0.1.12 + tag: v0.1.14 library exposed-modules: Data.Express @@ -92,7 +92,7 @@ main-is: main.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 test-suite core @@ -100,7 +100,7 @@ main-is: core.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 test-suite canon @@ -108,7 +108,7 @@ main-is: canon.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 test-suite hole @@ -116,7 +116,7 @@ main-is: hole.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 test-suite match @@ -124,7 +124,7 @@ main-is: match.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 test-suite map @@ -132,7 +132,7 @@ main-is: map.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 test-suite fixtures @@ -140,7 +140,7 @@ main-is: fixtures.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 test-suite instances @@ -148,7 +148,7 @@ main-is: instances.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 test-suite express-instances @@ -156,7 +156,7 @@ main-is: express.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 test-suite express-derive @@ -164,7 +164,7 @@ main-is: express-derive.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 test-suite ord @@ -172,7 +172,7 @@ main-is: ord.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 test-suite listable @@ -180,7 +180,7 @@ main-is: listable.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 test-suite name @@ -188,7 +188,7 @@ main-is: name.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 test-suite name-derive @@ -196,7 +196,7 @@ main-is: name-derive.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 test-suite fold @@ -204,7 +204,7 @@ main-is: fold.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 test-suite show @@ -212,7 +212,7 @@ main-is: show.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 test-suite triexpr @@ -220,7 +220,7 @@ main-is: triexpr.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 test-suite utils @@ -228,7 +228,7 @@ main-is: utils.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 benchmark compare @@ -236,7 +236,7 @@ main-is: compare.hs hs-source-dirs: bench, test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 benchmark pairs @@ -244,7 +244,7 @@ main-is: pairs.hs hs-source-dirs: bench, test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 benchmark sort @@ -252,7 +252,7 @@ main-is: sort.hs hs-source-dirs: bench, test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 benchmark tiers @@ -260,7 +260,7 @@ main-is: tiers.hs hs-source-dirs: bench, test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 benchmark match-list @@ -268,7 +268,7 @@ main-is: match-list.hs hs-source-dirs: bench, test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 benchmark match-noop @@ -276,7 +276,7 @@ main-is: match-noop.hs hs-source-dirs: bench, test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 benchmark match-triexpr @@ -284,26 +284,26 @@ main-is: match-triexpr.hs hs-source-dirs: bench, test other-modules: Test, Test.ListableExpr - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 benchmark u-extrapolate type: exitcode-stdio-1.0 main-is: u-extrapolate.hs hs-source-dirs: eg - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 benchmark u-speculate type: exitcode-stdio-1.0 main-is: u-speculate.hs hs-source-dirs: eg - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 benchmark u-conjure type: exitcode-stdio-1.0 main-is: u-conjure.hs hs-source-dirs: eg - build-depends: base >= 4 && < 5, express, leancheck >= 0.9.4 + build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10 default-language: Haskell2010 diff --git a/src/Data/Express/Core.hs b/src/Data/Express/Core.hs --- a/src/Data/Express/Core.hs +++ b/src/Data/Express/Core.hs @@ -470,6 +470,25 @@ showParen (d >= 0) $ showString "if " . showsPrecExpr 0 ep . showString " then " . showsPrecExpr 0 ex . showString " else " . showsPrecExpr 0 ey +showsPrecExpr d (Value ",.." _ :$ ex :$ ey :$ ez) = + showString "[" . showsPrecExpr 0 ex + . showString (if dotdot ex && dotdot ey && dotdot ez then "," else ", ") + . showsPrecExpr 0 ey + . showString (if dotdot ex && dotdot ey && dotdot ez then ".." else " .. ") + . showsPrecExpr 0 ez + . showString "]" +showsPrecExpr d (Value ",.." _ :$ ex :$ ey) = + showString "[" . showsPrecExpr 0 ex + . showString (if dotdot ex && dotdot ey then "," else ", ") + . showsPrecExpr 0 ey + . showString (if dotdot ex && dotdot ey then "..]" else " ..]") +showsPrecExpr d (Value ".." _ :$ ex :$ ey) = + showString "[" . showsPrecExpr 0 ex + . showString (if dotdot ex && dotdot ey then ".." else " .. ") + . showsPrecExpr 0 ey + . showString "]" +showsPrecExpr d (Value ".." _ :$ ex) = + showString "[" . showsPrecExpr 0 ex . showString (if dotdot ex then "..]" else " ..]") showsPrecExpr d (Value f' _ :$ e1 :$ e2) | isInfix f = showParen (d > prec f) $ showsOpExpr f e1 @@ -493,6 +512,11 @@ $ showsPrecExpr (prec " ") e1 . showString " " . showsPrecExpr (prec " " + 1) e2 + +-- Can we avoid a space using @[..]@? +dotdot :: Expr -> Bool +dotdot (Value (c:_) _) = isNumber c || isLower c || c == '_' || c == '\'' +dotdot _ = False -- bad smell here, repeated code! showsTailExpr :: Expr -> String -> String diff --git a/src/Data/Express/Express.hs b/src/Data/Express/Express.hs --- a/src/Data/Express/Express.hs +++ b/src/Data/Express/Express.hs @@ -177,7 +177,7 @@ -- type binding utilities -- --- | Type restricted version of const +-- | Type restricted version of 'const' -- that forces its first argument -- to have the same type as the second. -- @@ -186,7 +186,7 @@ (-:) = asTypeOf -- const infixl 1 -: --- | Type restricted version of const +-- | Type restricted version of 'const' -- that forces the result of its first argument -- to have the same type as the second. -- @@ -195,7 +195,7 @@ (->:) = const infixl 1 ->: --- | Type restricted version of const +-- | Type restricted version of 'const' -- that forces the result of the result of its first argument -- to have the same type as the second. -- @@ -204,7 +204,7 @@ (->>:) = const infixl 1 ->>: --- | Type restricted version of const +-- | Type restricted version of 'const' -- that forces the result of the result of the result of its first argument -- to have the same type as the second. (->>>:) :: (a -> b -> c -> d) -> d -> (a -> b -> c -> d) diff --git a/src/Data/Express/Fixtures.hs b/src/Data/Express/Fixtures.hs --- a/src/Data/Express/Fixtures.hs +++ b/src/Data/Express/Fixtures.hs @@ -138,7 +138,7 @@ -- ** Chars , c_ , cc, dd, ccs - , ae, bee, cee, dee + , ae, bee, cee, dee, zed, zee , space, lineBreak , ord' , ordE @@ -194,6 +194,12 @@ , mapE , (-.-) , map' + + -- ** Enum + , enumFrom', (-..) + , enumFromTo', (-..-) + , enumFromThen', (-...) + , enumFromThenTo', (-...-) ) where @@ -773,6 +779,30 @@ dee :: Expr dee = val 'd' +-- | The character @\'z\'@ encoded as an 'Expr' +-- +-- > > zed +-- > 'z' :: Char +-- +-- > > evl zed :: Char +-- > 'z' +-- +-- (cf. 'zee') +zed :: Expr +zed = val 'z' + +-- | The character @\'z\'@ encoded as an 'Expr' +-- +-- > > zee +-- > 'z' :: Char +-- +-- > > evl zee :: Char +-- > 'z' +-- +-- (cf. 'zed') +zee :: Expr +zee = val 'z' + space :: Expr space = val ' ' @@ -1304,3 +1334,79 @@ where err = error $ "map': unhandled type " ++ show (typ ef) type Map a = (a -> a) -> [a] -> [a] + +enumFrom' :: Expr -> Expr +enumFrom' ex = headOr err $ mapMaybe ($$ ex) + [ value "enumFrom" (enumFrom :: EnumFrom Int) + , value "enumFrom" (enumFrom :: EnumFrom Bool) + , value "enumFrom" (enumFrom :: EnumFrom Char) + ] + where + err = error $ "enumFrom': unhandled type " ++ show (typ ex) +type EnumFrom a = (a -> [a]) + +(-..) :: Expr -> Expr +(-..) ex = headOr err $ mapMaybe ($$ ex) + [ value ".." (enumFrom :: EnumFrom Int) + , value ".." (enumFrom :: EnumFrom Bool) + , value ".." (enumFrom :: EnumFrom Char) + ] + where + err = error $ "(-..): unhandled type " ++ show (typ ex) + +enumFromTo' :: Expr -> Expr -> Expr +enumFromTo' ex ey = (:$ ey) . headOr err $ mapMaybe ($$ ex) + [ value "enumFromTo" (enumFromTo :: EnumFromTo Int) + , value "enumFromTo" (enumFromTo :: EnumFromTo Bool) + , value "enumFromTo" (enumFromTo :: EnumFromTo Char) + ] + where + err = error $ "enumFromTo': unhandled type " ++ show (typ ex) +type EnumFromTo a = (a -> a -> [a]) + +(-..-) :: Expr -> Expr -> Expr +ex -..- ey = (:$ ey) . headOr err $ mapMaybe ($$ ex) + [ value ".." (enumFromTo :: EnumFromTo Int) + , value ".." (enumFromTo :: EnumFromTo Bool) + , value ".." (enumFromTo :: EnumFromTo Char) + ] + where + err = error $ "-..-: unhandled type " ++ show (typ ex) + +enumFromThen' :: Expr -> Expr -> Expr +enumFromThen' ex ey = (:$ ey) . headOr err $ mapMaybe ($$ ex) + [ value "enumFromThen" (enumFromThen :: EnumFromThen Int) + , value "enumFromThen" (enumFromThen :: EnumFromThen Bool) + , value "enumFromThen" (enumFromThen :: EnumFromThen Char) + ] + where + err = error $ "enumFromThen': unhandled type " ++ show (typ ex) +type EnumFromThen a = (a -> a -> [a]) + +(-...) :: Expr -> Expr -> Expr +ex -... ey = (:$ ey) . headOr err $ mapMaybe ($$ ex) + [ value ",.." (enumFromThen :: EnumFromThen Int) + , value ",.." (enumFromThen :: EnumFromThen Bool) + , value ",.." (enumFromThen :: EnumFromThen Char) + ] + where + err = error $ "-..-: unhandled type " ++ show (typ ex) + +enumFromThenTo' :: Expr -> Expr -> Expr -> Expr +enumFromThenTo' ex ey ez = (:$ ez) . (:$ ey) . headOr err $ mapMaybe ($$ ex) + [ value "enumFromThenTo" (enumFromThenTo :: EnumFromThenTo Int) + , value "enumFromThenTo" (enumFromThenTo :: EnumFromThenTo Bool) + , value "enumFromThenTo" (enumFromThenTo :: EnumFromThenTo Char) + ] + where + err = error $ "enumFromThenTo': unhandled type " ++ show (typ ex) +type EnumFromThenTo a = (a -> a -> a -> [a]) + +(-...-) :: Expr -> Expr -> Expr -> Expr +(ex -...- ey) ez = (:$ ez) . (:$ ey) . headOr err $ mapMaybe ($$ ex) + [ value ",.." (enumFromThenTo :: EnumFromThenTo Int) + , value ",.." (enumFromThenTo :: EnumFromThenTo Bool) + , value ",.." (enumFromThenTo :: EnumFromThenTo Char) + ] + where + err = error $ "-..-: unhandled type " ++ show (typ ex) diff --git a/src/Data/Express/Instances.hs b/src/Data/Express/Instances.hs --- a/src/Data/Express/Instances.hs +++ b/src/Data/Express/Instances.hs @@ -273,8 +273,11 @@ mkComparisonLE = mkComparison "<=" lookupName :: [Expr] -> Expr -> String -lookupName is e = fromMaybe "x" $ eval "x" <$> findValidApp es e +lookupName is e = fromMaybe d $ eval "x" <$> findValidApp es e where + t = typ e + d | isFunTy t = "f" + | otherwise = 'x' : replicate (countListTy t) 's' es = [e | e@(Value "name" _) <- is] lookupNames :: [Expr] -> Expr -> [String] diff --git a/src/Data/Express/Utils/Typeable.hs b/src/Data/Express/Utils/Typeable.hs --- a/src/Data/Express/Utils/Typeable.hs +++ b/src/Data/Express/Utils/Typeable.hs @@ -24,6 +24,7 @@ , elementTy , typesIn , typesInList + , countListTy , (->::) , module Data.Typeable ) @@ -111,6 +112,11 @@ isListTy t = case splitTyConApp t of (con,[_]) | con == listTyCon -> True _ -> False + +countListTy :: TypeRep -> Int +countListTy t = case splitTyConApp t of + (con,[t']) | con == listTyCon -> 1 + countListTy t' + _ -> 0 mkComparisonTy :: TypeRep -> TypeRep mkComparisonTy a = a ->:: a ->:: boolTy diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -4,4 +4,4 @@ - . extra-deps: -- leancheck-0.9.4 +- leancheck-0.9.10 diff --git a/test/canon.hs b/test/canon.hs --- a/test/canon.hs +++ b/test/canon.hs @@ -110,7 +110,37 @@ , holds n $ \e -> head (canonicalVariations e) == mostGeneralCanonicalVariation e , holds n $ \e -> last (canonicalVariations e) == mostSpecificCanonicalVariation e + + + -- Behaviour on unhandled types -- + , map show (canonicalVariations a_) + == ["x :: A"] + + , map show (canonicalVariations (faa_ :$ a_ :$ a_)) + == [ "f x y :: A" + , "f x x :: A" + ] + + , map show (canonicalVariations as_) + == ["xs :: [A]"] + + , map show (canonicalVariations (appendA :$ as_ :$ as_)) + == [ "xs ++ ys :: [A]" + , "xs ++ xs :: [A]" + ] ] + +a_ :: Expr +a_ = hole (undefined :: A) + +as_ :: Expr +as_ = hole (undefined :: [A]) + +faa_ :: Expr +faa_ = hole (undefined :: A -> A -> A) + +appendA :: Expr +appendA = value "++" ((++) :: [A] -> [A] -> [A]) -- O(1) bell number implementation -- only works up to 8 diff --git a/test/fixtures.hs b/test/fixtures.hs --- a/test/fixtures.hs +++ b/test/fixtures.hs @@ -174,4 +174,83 @@ -- if -- , evl (if' false zero one) == (1 :: Int) , evl (if' true two three) == (2 :: Int) + + -- enumFrom and enumFromTo + , show (enumFrom' false) == "enumFrom False :: [Bool]" + , evl (enumFrom' false) == [False,True] + , show (enumFromTo' zero four) == "enumFromTo 0 4 :: [Int]" + , evl (enumFromTo' zero four) == [0,1,2,3,4 :: Int] + + -- [ .. ] -- + , show ((-..) false) == "[False ..] :: [Bool]" + , evl ((-..) false) == [False,True] + , show ((-..) true) == "[True ..] :: [Bool]" + , evl ((-..) true) == [True] + , show (false -..- false) == "[False .. False] :: [Bool]" + , evl (false -..- false) == [False] + , show (false -..- true) == "[False .. True] :: [Bool]" + , evl (false -..- true) == [False,True] + , show (true -..- false) == "[True .. False] :: [Bool]" + , evl (true -..- false) == ([] :: [Bool]) + , show (true -..- true) == "[True .. True] :: [Bool]" + , evl (true -..- true) == [True] + + , show ((-..) zero) == "[0..] :: [Int]" + , show (zero -..- four) == "[0..4] :: [Int]" + , evl (zero -..- four) == [0,1,2,3,4 :: Int] + , show (minusTwo -..- minusOne) == "[-2 .. -1] :: [Int]" + , evl (minusTwo -..- minusOne) == [-2,-1 :: Int] + , show (minusTwo -..- two) == "[-2 .. 2] :: [Int]" + , evl (minusTwo -..- two) == [-2,-1,0,1,2 :: Int] + + , show ((-..) ae) == "['a'..] :: [Char]" + , show (ae -..- dee) == "['a'..'d'] :: [Char]" + , evl (ae -..- dee) == "abcd" + + , show (xx -..- yy) == "[x..y] :: [Int]" + , show (pp -..- qq) == "[p..q] :: [Bool]" + , show (cc -..- dd) == "[c..d] :: [Char]" + + , show (zero -..- yy) == "[0..y] :: [Int]" + , show (pp -..- true) == "[p .. True] :: [Bool]" + , show (cc -..- zed) == "[c..'z'] :: [Char]" + , show (ae -..- dd) == "['a'..d] :: [Char]" + + -- enumFromThen and enumFromThenTo + , show (enumFromThen' false true) == "enumFromThen False True :: [Bool]" + , evl (enumFromThen' false true) == [False,True] + , show (enumFromThenTo' zero two four) == "enumFromThenTo 0 2 4 :: [Int]" + , evl (enumFromThenTo' zero two four) == [0,2,4 :: Int] + + -- [, .. ] -- + , show ((-...) false true) == "[False, True ..] :: [Bool]" + , evl ((-...) false true) == [False,True] + , show ((-...) true false) == "[True, False ..] :: [Bool]" + , evl ((-...) true false) == [True,False] + , show ((false -...- false) true) == "[False, False .. True] :: [Bool]" + , show ((false -...- true) true) == "[False, True .. True] :: [Bool]" + , evl ((false -...- true) true) == [False,True] + + , show ((-...) zero one) == "[0,1..] :: [Int]" + , show ((zero -...- two) four) == "[0,2..4] :: [Int]" + , evl ((zero -...- two) four) == [0,2,4 :: Int] + , show ((minusTwo -...- one) minusOne) == "[-2, 1 .. -1] :: [Int]" + , evl ((minusTwo -...- one) minusOne) == [-2 :: Int] + , show ((minusTwo -...- zero) two) == "[-2, 0 .. 2] :: [Int]" + , evl ((minusTwo -...- zero) two) == [-2,0,2 :: Int] + + , show ((-...) ae bee) == "['a','b'..] :: [Char]" + , show ((ae -...- bee) dee) == "['a','b'..'d'] :: [Char]" + , evl ((ae -...- bee) dee) == "abcd" + , show ((ae -...- dee) zed) == "['a','d'..'z'] :: [Char]" + , evl ((ae -...- dee) zed) == "adgjmpsvy" + + , show ((xx -...- yy) zz) == "[x,y..z] :: [Int]" + , show ((pp -...- qq) rr) == "[p,q..r] :: [Bool]" + , show ((cc -...- dd) cc) == "[c,d..c] :: [Char]" + + , show ((zero -...- yy) zz) == "[0,y..z] :: [Int]" + , show ((pp -...- true) true) == "[p, True .. True] :: [Bool]" + , show ((cc -...- dd) zed) == "[c,d..'z'] :: [Char]" + , show ((ae -...- dd) cc) == "['a',d..c] :: [Char]" ] diff --git a/test/instances.hs b/test/instances.hs --- a/test/instances.hs +++ b/test/instances.hs @@ -32,6 +32,34 @@ , eval undefined (nameFor (undefined :: Bool) :$ qq) == "p" , length (validApps functions one) == 5 + + -- when lookupName does not find a name instance, + -- it defaults to x, xs, xss, xsss, ... + -- depending on the number of list nestings + , lookupName [] (val (0::Int)) == "x" + , lookupName [] (val [0::Int]) == "xs" + , lookupName [] (val [[0::Int]]) == "xss" + , lookupName [] (val [[[0::Int]]]) == "xsss" + + , lookupName [] (val False) == "x" + , lookupName [] (val [False]) == "xs" + , lookupName [] (val [[False]]) == "xss" + , lookupName [] (val [[[False]]]) == "xsss" + + , lookupName [] (val (0::A)) == "x" + , lookupName [] (val [0::A]) == "xs" + , lookupName [] (val [[0::A]]) == "xss" + , lookupName [] (val [[[0::A]]]) == "xsss" + + , lookupName preludeNameInstances (val False) == "p" + , lookupName preludeNameInstances (val [False]) == "ps" + , lookupName preludeNameInstances (val [[False]]) == "xss" -- XXX: caveat + , lookupName preludeNameInstances (val [[[False]]]) == "xsss" -- XXX: caveat + + , lookupName preludeNameInstances (val (0::A)) == "x" + , lookupName preludeNameInstances (val [0::A]) == "xs" + , lookupName preludeNameInstances (val [[0::A]]) == "xss" + , lookupName preludeNameInstances (val [[[0::A]]]) == "xsss" ] where eqFor = head . reifyEq diff --git a/test/show.hs b/test/show.hs --- a/test/show.hs +++ b/test/show.hs @@ -96,4 +96,28 @@ , show (hole (undefined :: Int -> Int) :$ xx) == "_ x :: Int" , show (hole (undefined :: Int -> Int -> Int) :$ one :$ xx) == "_ 1 x :: Int" , show (hole (undefined :: Int -> Int -> Int) :$ i_ :$ i_) == "_ _ _ :: Int" + + -- A type -- + , show (hole (undefined :: A)) == "_ :: A" + , show (val (0 :: A)) == "0 :: A" + , show (val (1 :: A)) == "1 :: A" + , show (val (2 :: A)) == "2 :: A" + , show (var "x" (undefined :: A)) == "x :: A" + , show (value "id" (id :: A -> A) :$ var "x" (undefined :: A)) == "id x :: A" + + -- B type -- + , show (hole (undefined :: B)) == "_ :: B" + , show (val (0 :: B)) == "0 :: B" + , show (val (1 :: B)) == "1 :: B" + , show (val (2 :: B)) == "2 :: B" + , show (var "x" (undefined :: B)) == "x :: B" + , show (value "id" (id :: B -> B) :$ var "x" (undefined :: B)) == "id x :: B" + + -- [A] type -- + , show (hole (undefined :: [A])) == "_ :: [A]" + , show (val ([0] :: [A])) == "[0] :: [A]" + , show (val ([3,1] :: [A])) == "[3,1] :: [A]" + , show (val ([0,1,2] :: [A])) == "[0,1,2] :: [A]" + , show (var "xs" (undefined :: [A])) == "xs :: [A]" + , show (value "id" (id :: [A] -> [A]) :$ var "xs" (undefined :: [A])) == "id xs :: [A]" ]