express 0.1.14 → 0.1.16
raw patch · 22 files changed
+934/−124 lines, 22 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Data.Express.Fixtures: cs_ :: Expr
+ Data.Express.Fixtures: eight :: Expr
+ Data.Express.Fixtures: eleven :: Expr
+ Data.Express.Fixtures: five :: Expr
+ Data.Express.Fixtures: minus :: Expr
+ Data.Express.Fixtures: nine :: Expr
+ Data.Express.Fixtures: seven :: Expr
+ Data.Express.Fixtures: six :: Expr
+ Data.Express.Fixtures: ten :: Expr
+ Data.Express.Fixtures: twelve :: Expr
Files
- .github/workflows/build.yml +10/−4
- Makefile +6/−4
- README.md +4/−0
- TODO.md +2/−12
- changelog.md +13/−0
- etc/hugs-backports/Data/Function.hs +13/−0
- express.cabal +17/−6
- mk/depend.mk +70/−18
- src/Data/Express/Core.hs +35/−13
- src/Data/Express/Express.hs +6/−3
- src/Data/Express/Fixtures.hs +312/−10
- src/Data/Express/Fold.hs +46/−6
- src/Data/Express/Instances.hs +53/−4
- src/Data/Express/Match.hs +2/−4
- src/Data/Express/Triexpr.hs +14/−2
- src/Data/Express/Utils.hs +46/−0
- src/Data/Express/Utils/List.hs +27/−0
- src/Data/Express/Utils/String.hs +32/−5
- src/Data/Express/Utils/TH.hs +96/−26
- src/Data/Express/Utils/Typeable.hs +111/−5
- test/Test/ListableExpr.hs +0/−2
- test/typecheck.hs +19/−0
.github/workflows/build.yml view
@@ -30,8 +30,10 @@ - run: du -hd3 ~/.cabal ~/.ghc || true - run: haddock --version || sudo apt-get install ghc-haddock- - run: ghc --version- - run: cabal --version+ - run: ghc --version+ - run: cabal --version+ - run: haddock --version+ - run: ghc-pkg list - name: Check out repository uses: actions/checkout@v2@@ -86,8 +88,10 @@ - run: make --version || apt-get update - run: make --version || apt-get install make - - run: ghc --version- - run: cabal --version+ - run: ghc --version+ - run: cabal --version+ - run: haddock --version+ - run: ghc-pkg list - name: Check out repository uses: actions/checkout@v2@@ -116,6 +120,8 @@ path: ~/.stack key: v1-${{ runner.os }}-stack-${{ hashFiles('stack.yaml') }} restore-keys: v1-${{ runner.os }}-stack-++ - run: stack --version - name: Check out repository uses: actions/checkout@v2
Makefile view
@@ -37,7 +37,7 @@ $(EGS) GHCIMPORTDIRS = src:test GHCFLAGS = -O2 $(shell grep -q "Arch Linux" /etc/lsb-release && echo -dynamic)-HUGSIMPORTDIRS = .:./src:./test:./etc/hugs-backports:/usr/lib/hugs/packages/*+HUGSIMPORTDIRS = .:./src:./test:./etc/hugs-backports:/usr/lib/hugs/packages/*:../leancheck/src HUGSFLAGS = -98 -h32M RUNPARAMETERS = LIB_DEPS = base template-haskell@@ -72,6 +72,11 @@ ghci: mk/All.ghci +hugs: src/Data/Express/Core.hugs++hugs-test: \+ test/typecheck.runhugs+ install: @echo "use \`cabal install' instead" @@ -97,9 +102,6 @@ ./$< > test/model/$<.out test-via-everything: test test-via-cabal test-via-stack--hugs-test:- echo 'TBA' legacy-test: # needs ghc-8.8 .. ghc-7.8 installed as such make clean && make test -j GHC=ghc-8.8
README.md view
@@ -416,6 +416,10 @@ For more examples, see the [eg](eg) and [bench](bench) folders. +Express is subject to a paper+"[Express: Applications of Dynamically Typed Haskell Expressions](https://matela.com.br/express.pdf)"+(2021).+ [Express's Haddock documentation]: https://hackage.haskell.org/package/express/docs/Data-Express.html
TODO.md view
@@ -1,14 +1,4 @@-TO DO list for express+TO DO list for Express ====================== -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`--* sweep occurrences of `TODO:` throughout source files--* Document `test/Test.ListableExpr` module thoroughly;+Nothing planned at the moment.
changelog.md view
@@ -2,6 +2,19 @@ ===================== +v0.1.16+-------++* add `five`, `six`, ... `twelve` to `Data.Express.Fixtures`.++* add `cs_` to `Data.Express.Fixtures`.++* improve backwards compatibility:+ `Data.Express.Core/Hole/Match/Map/Name/Triexpr/Utils` now work on Hugs.++* 100% Haddock coverage on most modules including REPL examples.++ v0.1.14 -------
+ etc/hugs-backports/Data/Function.hs view
@@ -0,0 +1,13 @@+-- Backport of Data.Function for Hugs 2006-09.+-- Only exports `on`+--+-- Copyright (c) 2018-2021 Rudy Matela.+-- Distributed under the 3-Clause BSD licence (see the file LICENSE).+module Data.Function+ ( on+ )+where++on :: (b -> b -> c) -> (a -> b) -> a -> a -> c+(?) `on` f = \x y -> f x ? f y+infixl 0 `on`
express.cabal view
@@ -1,11 +1,11 @@ -- Cabal file for express name: express-version: 0.1.14-synopsis: Dynamically-typed expressions involving applications and variables.+version: 0.1.16+synopsis: Dynamically-typed expressions involving function application and variables. description: Express is a library for manipulating dynamically typed Haskell expressions.- It's like @ Data.Dynamic @ but with support for encoding applications and- variables.+ It's like @ Data.Dynamic @ but+ with support for encoding function aplication and variables. . It provides the @ Expr @ type and over a hundred functions for building, evaluating, comparing, folding, canonicalizing and matching@@ -43,6 +43,7 @@ , bench/runtime/zero/versions , bench/runtime/zero/bench/*.runtime , bench/runtime/zero/eg/*.runtime+ , etc/hugs-backports/Data/Function.hs tested-with: GHC==9.0 , GHC==8.10 , GHC==8.8@@ -52,7 +53,8 @@ , GHC==8.0 , GHC==7.10 , GHC==7.8-+ , Hugs==2006.9+-- for Hugs, not all modules are supported, see test/typecheck.hs source-repository head type: git@@ -61,7 +63,7 @@ source-repository this type: git location: https://github.com/rudymatela/express- tag: v0.1.14+ tag: v0.1.16 library exposed-modules: Data.Express@@ -79,6 +81,7 @@ , Data.Express.Canon , Data.Express.Match , Data.Express.Triexpr+ , Data.Express.Utils , Data.Express.Utils.List , Data.Express.Utils.String , Data.Express.Utils.Typeable@@ -226,6 +229,14 @@ test-suite utils type: exitcode-stdio-1.0 main-is: utils.hs+ hs-source-dirs: test+ other-modules: Test, Test.ListableExpr+ build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10+ default-language: Haskell2010++test-suite typecheck+ type: exitcode-stdio-1.0+ main-is: typecheck.hs hs-source-dirs: test other-modules: Test, Test.ListableExpr build-depends: base >= 4 && < 5, express, leancheck >= 0.9.10
mk/depend.mk view
@@ -4,6 +4,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -31,6 +32,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -58,6 +60,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -85,6 +88,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express/Triexpr.hs \ src/Data/Express.hs \@@ -113,6 +117,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -140,6 +145,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -167,6 +173,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -195,6 +202,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -217,6 +225,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -239,6 +248,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -254,10 +264,13 @@ src/Data/Express/Canon.hs \ src/Data/Express/Basic.hs \ eg/u-speculate.hs+etc/hugs-backports/Data/Function.o: \+ etc/hugs-backports/Data/Function.hs mk/All.o: \ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express/Triexpr.hs \ src/Data/Express.hs \@@ -281,6 +294,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express/Triexpr.hs \ src/Data/Express.hs \@@ -301,6 +315,7 @@ src/Data/Express/Basic.o: \ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express/Map.hs \ src/Data/Express/Hole.hs \@@ -310,6 +325,7 @@ src/Data/Express/Canon.o: \ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express/Name.hs \ src/Data/Express/Map.hs \@@ -323,12 +339,14 @@ src/Data/Express/Core.o: \ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express/Core.hs src/Data/Express/Express/Derive.o: \ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express/Express.hs \ src/Data/Express/Express/Derive.hs \@@ -336,6 +354,7 @@ src/Data/Express/Express.o: \ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express/Express.hs \ src/Data/Express/Core.hs@@ -345,6 +364,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -363,6 +383,7 @@ src/Data/Express/Fold.o: \ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express/Fold.hs \ src/Data/Express/Core.hs@@ -371,12 +392,14 @@ src/Data/Express/Hole.o: \ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express/Hole.hs \ src/Data/Express/Core.hs src/Data/Express/Instances.o: \ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express/Name.hs \ src/Data/Express/Map.hs \@@ -389,19 +412,17 @@ src/Data/Express/Map.o: \ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express/Map.hs \ src/Data/Express/Core.hs src/Data/Express/Match.o: \ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express/Match.hs \- src/Data/Express/Map.hs \- src/Data/Express/Hole.hs \- src/Data/Express/Fold.hs \- src/Data/Express/Core.hs \- src/Data/Express/Basic.hs+ src/Data/Express/Core.hs src/Data/Express/Name/Derive.o: \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \@@ -414,6 +435,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -430,31 +452,26 @@ src/Data/Express/Basic.hs src/Data/Express/Triexpr.o: \ src/Data/Express/Utils/Typeable.hs \- src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express/Triexpr.hs \- src/Data/Express.hs \- src/Data/Express/Name.hs \- src/Data/Express/Name/Derive.hs \ src/Data/Express/Match.hs \- src/Data/Express/Map.hs \- src/Data/Express/Instances.hs \- src/Data/Express/Hole.hs \- src/Data/Express/Fold.hs \- src/Data/Express/Express.hs \- src/Data/Express/Express/Derive.hs \- src/Data/Express/Core.hs \- src/Data/Express/Canon.hs \- src/Data/Express/Basic.hs+ src/Data/Express/Core.hs src/Data/Express/Utils/List.o: \ src/Data/Express/Utils/List.hs+src/Data/Express/Utils.o: \+ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \+ src/Data/Express/Utils/List.hs src/Data/Express/Utils/String.o: \ src/Data/Express/Utils/String.hs src/Data/Express/Utils/TH.o: \ src/Data/Express/Utils/TH.hs src/Data/Express/Utils/Typeable.o: \ src/Data/Express/Utils/Typeable.hs \+ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs test/canon.o: \ test/Test.hs \@@ -463,6 +480,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -490,6 +508,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -517,6 +536,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -544,6 +564,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -571,6 +592,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -598,6 +620,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -625,6 +648,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -652,6 +676,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -679,6 +704,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -706,6 +732,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -733,6 +760,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -760,6 +788,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -787,6 +816,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -814,6 +844,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -841,6 +872,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -868,6 +900,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -893,6 +926,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -914,6 +948,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \@@ -940,6 +975,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express/Triexpr.hs \ src/Data/Express.hs \@@ -961,6 +997,21 @@ test/Test.hs \ test/Test/ListableExpr.hs \ mk/toplibs+test/typecheck.o: \+ test/typecheck.hs \+ src/Data/Express/Utils/Typeable.hs \+ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \+ src/Data/Express/Utils/List.hs \+ src/Data/Express/Triexpr.hs \+ src/Data/Express/Name.hs \+ src/Data/Express/Match.hs \+ src/Data/Express/Map.hs \+ src/Data/Express/Hole.hs \+ src/Data/Express/Core.hs+test/typecheck: \+ test/typecheck.hs \+ mk/toplibs test/utils.o: \ test/utils.hs \ test/Test.hs \@@ -968,6 +1019,7 @@ src/Data/Express/Utils/Typeable.hs \ src/Data/Express/Utils/TH.hs \ src/Data/Express/Utils/String.hs \+ src/Data/Express/Utils.hs \ src/Data/Express/Utils/List.hs \ src/Data/Express.hs \ src/Data/Express/Name.hs \
src/Data/Express/Core.hs view
@@ -14,7 +14,10 @@ -- The complexity of most functions are given in big O notation -- where /n/ is the size of the expression being manipulated or produced. -- There may still be a /m/ cost associated with the values being stored in 'Expr's.-{-# LANGUAGE DeriveDataTypeable #-} -- for GHC < 7.10+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ == 708+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+#endif module Data.Express.Core ( -- * The Expr datatype@@ -76,14 +79,7 @@ where import Data.Dynamic-import Data.Function (on)-import Data.List (intercalate, sort)-import Data.Maybe (fromMaybe, isNothing, isJust)-import Data.Either (either)-import Data.Monoid ((<>))--import Data.Express.Utils.List-import Data.Express.Utils.String+import Data.Express.Utils import Data.Express.Utils.Typeable -- |@@ -129,8 +125,11 @@ -- represents a 'var'iable. data Expr = Value String Dynamic -- ^ a 'value' enconded as 'String' and 'Dynamic' | Expr :$ Expr -- ^ function application between expressions- deriving Typeable -- for GHC < 7.10 +#if __GLASGOW_HASKELL__ == 708+deriving instance Typeable Expr+#endif+ -- | /O(1)/. -- It takes a string representation of a value and a value, returning an -- 'Expr' with that terminal value.@@ -535,9 +534,32 @@ showsOpExpr :: String -> Expr -> String -> String showsOpExpr op = showsPrecExpr (prec op + 1) +-- | /O(n)/.+-- Like 'showPrecExpr' but+-- the precedence is taken from the given operator name.+--+-- > > showOpExpr "*" (two -*- three)+-- > "(2 * 3)"+--+-- > > showOpExpr "+" (two -*- three)+-- > "2 * 3"+--+-- To imply that the surrounding environment is a function application,+-- use @" "@ as the given operator.+--+-- > > showOpExpr " " (two -*- three)+-- > "(2 * 3)" showOpExpr :: String -> Expr -> String showOpExpr op = showPrecExpr (prec op + 1) +-- | /O(n)/.+-- Like 'showExpr' but allows specifying the surrounding precedence.+--+-- > > showPrecExpr 6 (one -+- two)+-- > "1 + 2"+--+-- > > showPrecExpr 7 (one -+- two)+-- > "(1 + 2)" showPrecExpr :: Int -> Expr -> String showPrecExpr n e = showsPrecExpr n e "" @@ -560,9 +582,9 @@ -- -- This instance works for ill-typed expressions. instance Eq Expr where- Value s1 d1 == Value s2 d2 = s1 == s2 && dynTypeRep d1 == dynTypeRep d2- ef1 :$ ex1 == ef2 :$ ex2 = ef1 == ef2 && ex1 == ex2- _ == _ = False+ Value s1 d1 == Value s2 d2 = s1 == s2 && dynTypeRep d1 == dynTypeRep d2+ (ef1 :$ ex1) == (ef2 :$ ex2) = ef1 == ef2 && ex1 == ex2+ _ == _ = False -- | /O(n)/. -- Does not evaluate values when comparing, but rather uses their
src/Data/Express/Express.hs view
@@ -100,11 +100,14 @@ instance (Integral a, Express a) => Express (Ratio a) where expr = val+-- note that the "Integral a" restriction above is needed on GHC <= 7.10++-- TODO: deeply encode ratios+-- NOTE: -- The following would allow zero denominators -- expr (n % d) = constant "%" ((%) -:> n) :$ expr n :$ expr d--- TODO: allow zero denominators as it is not our problem--- but only after refactoring Extrapolate to use Express--- note that the "Integral a" restriction above is needed on GHC <= 7.10+-- but that is not our problem here!+-- Nevertheless, we should change and see the effect on Extrapolate first... instance (Express a, Express b, Express c, Express d, Express e) => Express (a,b,c,d,e) where
src/Data/Express/Fixtures.hs view
@@ -42,7 +42,7 @@ -- or playing around on GHCi. -- -- Since the 'Expr' type only allows monomorphic values,--- encoded polimorphic values are monomorphized+-- encoded polymorphic values are monomorphized -- usually to the 'Int' type. -- -- /Beware:/ lifted 'Expr' functions sometimes work for different types.@@ -116,7 +116,9 @@ , i_, xx, yy, zz, xx' , ii, jj, kk, ii' , ll, mm, nn- , zero, one, two, three, four, minusOne, minusTwo+ , zero, one, two, three, four, five, six+ , seven, eight, nine, ten, eleven, twelve+ , minusOne, minusTwo , idE, negateE, absE, signumE , idInt , idBool@@ -125,7 +127,7 @@ , idBools , idString , id', const', negate', abs', signum'- , plus, times+ , plus, times, minus , (-+-), (-*-) , ff, ffE , gg, ggE@@ -136,7 +138,7 @@ , even' -- ** Chars- , c_+ , c_, cs_ , cc, dd, ccs , ae, bee, cee, dee, zed, zee , space, lineBreak@@ -292,10 +294,18 @@ orE :: Expr orE = value "||" (||) +-- | The function @==>@ lifted over 'Expr's.+--+-- > > false -==>- true+-- > False ==> True :: Bool+--+-- > > evl $ false -==>- true :: Bool+-- > True (-==>-) :: Expr -> Expr -> Expr e1 -==>- e2 = implies :$ e1 :$ e2 infixr 0 -==>- +-- | The @==>@ operator encoded as an 'Expr' implies :: Expr implies = value "==>" (==>) where@@ -463,6 +473,62 @@ four :: Expr four = val (4 :: Int) +-- | The value @5@ bound to the 'Int' type encoded as an 'Expr'.+--+-- > > five+-- > 5 :: Int+five :: Expr+five = val (5 :: Int)++-- | The value @6@ bound to the 'Int' type encoded as an 'Expr'.+--+-- > > six+-- > 6 :: Int+six :: Expr+six = val (6 :: Int)++-- | The value @7@ bound to the 'Int' type encoded as an 'Expr'.+--+-- > > seven+-- > 7 :: Int+seven :: Expr+seven = val (7 :: Int)++-- | The value @8@ bound to the 'Int' type encoded as an 'Expr'.+--+-- > > eight+-- > 8 :: Int+eight :: Expr+eight = val (8 :: Int)++-- | The value @9@ bound to the 'Int' type encoded as an 'Expr'.+--+-- > > nine+-- > 9 :: Int+nine :: Expr+nine = val (9 :: Int)++-- | The value @10@ bound to the 'Int' type encoded as an 'Expr'.+--+-- > > ten+-- > 10 :: Int+ten :: Expr+ten = val (10 :: Int)++-- | The value @11@ bound to the 'Int' type encoded as an 'Expr'.+--+-- > > eleven+-- > 11 :: Int+eleven :: Expr+eleven = val (11 :: Int)++-- | The value @12@ bound to the 'Int' type encoded as an 'Expr'.+--+-- > > twelve+-- > 12 :: Int+twelve :: Expr+twelve = val (12 :: Int)+ -- | The value @-1@ bound to the 'Int' type encoded as an 'Expr'. -- -- > > minusOne@@ -602,6 +668,13 @@ times :: Expr times = value "*" ((*) :: Int -> Int -> Int) +-- | The subtraction '-' operator encoded as an 'Expr'.+--+-- > > minus :$ one+-- > (1 -) :: Int -> Int+--+-- > > minus :$ one :$ zero+-- > 1 - 0 :: Int minus :: Expr minus = value "-" ((-) :: Int -> Int -> Int) @@ -660,6 +733,12 @@ idString = value "id" (id :: Id String) type Id a = a -> a +-- | The 'const' function lifted over the 'Expr' type.+--+-- > > const' zero one+-- > const 0 1 :: Int+--+-- This works for the argument types 'Int', 'Char', 'Bool' and their lists. const' :: Expr -> Expr -> Expr const' e1 e2 = (:$ e2) . headOr err $ mapMaybe ($$ e1) [ value "const" (const :: Int -> Int -> Int)@@ -723,9 +802,23 @@ signumE :: Expr signumE = value "signum" (signum :: Int -> Int) +-- | 'odd' with an 'Int' argument lifted over the 'Expr' type.+--+-- > > odd' (xx -+- one)+-- > odd (x + 1) :: Bool+--+-- > > evl (odd' two) :: Bool+-- > False odd' :: Expr -> Expr odd' = (oddE :$) where oddE = value "odd" (odd :: Int -> Bool) +-- | 'even' with an 'Int' argument lifted over the 'Expr' type.+--+-- > > even' (xx -+- two)+-- > even (x + 2) :: Bool+--+-- > > evl (even' two) :: Bool+-- > True even' :: Expr -> Expr even' = (evenE :$) where evenE = value "even" (even :: Int -> Bool) @@ -736,18 +829,44 @@ c_ :: Expr c_ = hole char +-- | A hole of 'String' type encoded as an 'Expr'.+--+-- > > cs_+-- > _ :: [Char]+cs_ :: Expr+cs_ = hole [char]++-- | A variable named @c@ of type 'Char' encoded as an 'Expr'.+--+-- > > cc+-- > c :: Char cc :: Expr cc = var "c" char +-- | A variable named @c@ of type 'Char' encoded as an 'Expr'.+--+-- > > dd+-- > d :: Char dd :: Expr dd = var "d" char +-- | A variable named @cs@ of type 'String' encoded as an 'Expr'.+--+-- > > ccs+-- > cs :: [Char] ccs :: Expr ccs = var "cs" [char] --- The English name for letter 'a' is not really 'ae', but simply 'a'.+-- | The character @\'a\'@ encoded as an 'Expr'.+--+-- > > ae+-- > 'a' :: Char+--+-- > > evl ae :: Char+-- > 'a' ae :: Expr ae = val 'a'+-- The English name for letter 'a' is not really 'ae', but simply 'a'. -- | The character @\'b\'@ encoded as an 'Expr' --@@ -803,15 +922,31 @@ zee :: Expr zee = val 'z' +-- | The space character encoded as an 'Expr'+--+-- > > space+-- > ' ' :: Char space :: Expr space = val ' ' +-- | The line break character encoded as an 'Expr'+--+-- > > lineBreak+-- > '\n' :: Char lineBreak :: Expr lineBreak = val '\n' +-- | The 'ord' function lifted over 'Expr'+--+-- > > ord' bee+-- > ord 'b' :: Int+--+-- > > evl (ord' bee)+-- > 98 ord' :: Expr -> Expr ord' = (ordE :$) +-- | The 'ord' function encoded as an 'Expr' ordE :: Expr ordE = value "ord" ord @@ -919,6 +1054,7 @@ err = error $ "(-:-): unhandled type " ++ show (typ e1) infixr 5 -:- +-- | Append for list of 'Int's encoded as an 'Expr'. appendInt :: Expr appendInt = value "++" ((++) :: [Int] -> [Int] -> [Int]) @@ -1029,6 +1165,20 @@ where err = error $ "length': cannot apply `length :: [a] -> a` to `" ++ show exs ++ "'." +-- | List 'sort' lifted over the 'Expr' type.+-- Works for the element types 'Int', 'Char' and 'Bool'.+--+-- > > sort' $ unit one+-- > sort [1] :: Int+--+-- > > sort' $ unit bee+-- > sort "b" :: Int+--+-- > > sort' $ zero -:- unit two+-- > sort [0,2] :: Int+--+-- > > evl $ sort' $ two -:- unit one :: [Int]+-- > [1,2] sort' :: Expr -> Expr sort' exs = headOr err $ mapMaybe ($$ exs) [ value "sort" (sort :: [Int] -> [Int])@@ -1038,6 +1188,14 @@ where err = error $ "sort': unhandled type " ++ show (typ exs) +-- | List 'insert' lifted over the 'Expr' type.+-- Works for the element types 'Int', 'Char' and 'Bool'.+--+-- > > insert' zero nilInt+-- > insert 0 [] :: [Int]+--+-- > > insert' false (false -:- unit true)+-- > insert False [False,True] :: [Bool] insert' :: Expr -> Expr -> Expr insert' ex exs = (:$ exs) . headOr err $ mapMaybe ($$ ex) [ value "insert" (insert :: Int -> [Int] -> [Int])@@ -1047,6 +1205,14 @@ where err = error $ "insert': unhandled type " ++ show (typ ex) +-- | List 'elem' lifted over the 'Expr' type.+-- Works for the element types 'Int', 'Char' and 'Bool'.+--+-- > > elem' false (false -:- unit true)+-- > elem False [False,True] :: Bool+--+-- > > evl $ elem' false (false -:- unit true) :: Bool+-- > True elem' :: Expr -> Expr -> Expr elem' ex exs = (:$ exs) . headOr err $ mapMaybe ($$ ex) [ value "elem" (elem :: Int -> [Int] -> Bool)@@ -1056,6 +1222,12 @@ where err = error $ "elem': unhandled type " ++ show (typ ex) +-- | '$' lifted over 'Expr's+--+-- > > absE -$- one+-- > abs $ 1 :: Int+--+-- Works for 'Int', 'Bool', 'Char' argument types and their lists. (-$-) :: Expr -> Expr -> Expr ef -$- ex = (:$ ex) . headOr err $ mapMaybe ($$ ef) [ value "$" (($) :: Apply Int)@@ -1070,6 +1242,15 @@ infixl 6 -$- type Apply a = (a -> a) -> a -> a +-- | Constructs an equation between two 'Expr's.+--+-- > > xx -==- zero+-- > x == 0 :: Bool+--+-- > > cc -==- dee+-- > c == 'd' :: Bool+--+-- This works for the 'Int', 'Bool', 'Char' argument types and their lists. (-==-) :: Expr -> Expr -> Expr ex -==- ey = (:$ ey) . headOr err $ mapMaybe ($$ ex) [ value "==" ((==) :: Comparison ())@@ -1085,6 +1266,13 @@ infix 4 -==- type Comparison a = a -> a -> Bool +-- | Constructs an inequation between two 'Expr's.+--+-- > > xx -/=- zero+-- > x /= 0 :: Bool+--+-- > > cc -/=- ae+-- > c /= 'a' :: Bool (-/=-) :: Expr -> Expr -> Expr ex -/=- ey = (:$ ey) . headOr err $ mapMaybe ($$ ex) [ value "/=" ((/=) :: Comparison ())@@ -1099,6 +1287,13 @@ err = error $ "(-/=-): unhandled type " ++ show (typ ex) infix 4 -/=- +-- | Constructs a less-than-or-equal inequation between two 'Expr's.+--+-- > > xx -<=- zero+-- > x <= 0 :: Bool+--+-- > > cc -<=- ae+-- > c <= 'a' :: Bool (-<=-) :: Expr -> Expr -> Expr ex -<=- ey = (:$ ey) . headOr err $ mapMaybe ($$ ex) [ value "<=" ((<=) :: Comparison ())@@ -1113,6 +1308,13 @@ err = error $ "(-<=-): unhandled type " ++ show (typ ex) infix 4 -<=- +-- | Constructs a less-than inequation between two 'Expr's.+--+-- > > xx -<- zero+-- > x < 0 :: Bool+--+-- > > cc -<- bee+-- > c < 'b' :: Bool (-<-) :: Expr -> Expr -> Expr ex -<- ey = (:$ ey) . headOr err $ mapMaybe ($$ ex) [ value "<" ((<) :: Comparison ())@@ -1157,6 +1359,13 @@ iff p x y = if p then x else y type If a = Bool -> a -> a -> a +-- | Constructs an 'Expr'-encoded 'compare' operation between two 'Expr's.+--+-- > > xx `compare'` zero+-- > compare x 0 :: Ordering+--+-- > > compare' ae bee+-- > compare 'a' 'b' :: Ordering compare' :: Expr -> Expr -> Expr compare' ex ey = (:$ ey) . headOr err $ mapMaybe ($$ ex) [ value "compare" (compare :: Compare ())@@ -1171,18 +1380,36 @@ err = error $ "(-<-): unhandled type " ++ show (typ ex) type Compare a = a -> a -> Ordering +-- | 'Nothing' bound to the 'Maybe' 'Int' type encoded as an 'Expr'.+--+-- This is an alias to 'nothingInt'. nothing :: Expr nothing = nothingInt -nothingInt, nothingBool :: Expr+-- | 'Nothing' bound to the 'Maybe' 'Int' type encoded as an 'Expr'.+nothingInt :: Expr nothingInt = val (Nothing :: Maybe Int)++-- | 'Nothing' bound to the 'Maybe' 'Bool' type encoded as an 'Expr'.+nothingBool :: Expr nothingBool = val (Nothing :: Maybe Bool) -justInt, justBool :: Expr-justInt = value "Just" (Just :: Just Int)-justBool = value "Just" (Just :: Just Bool)-type Just a = a -> Maybe a+-- | The 'Just' constructor of the 'Int' element type encoded as an 'Expr'.+justInt :: Expr+justInt = value "Just" (Just :: Int -> Maybe Int) +-- | The 'Just' constructor of the 'Bool' element type encoded as an 'Expr'.+justBool :: Expr+justBool = value "Just" (Just :: Bool -> Maybe Bool)++-- | The 'Just' constructor lifted over the 'Expr' type.+--+-- This works for the 'Bool' and 'Int' argument types.+--+-- > > just zero+-- > Just 0 :: Maybe Int+-- > > just false+-- > Just False :: Maybe Bool just :: Expr -> Expr just ex = headOr err $ mapMaybe ($$ ex) [ justInt@@ -1191,9 +1418,14 @@ where err = error $ "just: unhandled type " ++ show (typ ex) +-- | An infix synonym of 'pair'. (-|-) :: Expr -> Expr -> Expr (-|-) = pair +-- | The pair constructor lifted over 'Expr's.+--+-- This works for the 'Int' and 'Bool' element types+-- by differently from 'foldPair' by returning a well-typed expression. pair :: Expr -> Expr -> Expr pair x y = comma :$ x :$ y where@@ -1205,24 +1437,37 @@ (t,t') -> error $ "(-:-): unhandled types " ++ t ++ " " ++ t' type Pair a b = a -> b -> (a,b) +-- | The pair constructor (@ :: ... -> (Int,Int) @) encoded as an 'Expr'. comma :: Expr comma = value "," ((,) :: Pair Int Int) +-- | The triple/trio constructor lifted over 'Expr's.+--+-- This only works for the 'Int' element type. triple :: Expr -> Expr -> Expr -> Expr triple e1 e2 e3 = ccE :$ e1 :$ e2 :$ e3 where ccE = value ",," ((,,) :: Int -> Int -> Int -> (Int,Int,Int)) +-- | The quadruple constructor lifted over 'Expr's.+--+-- This only works for the 'Int' element type. quadruple :: Expr -> Expr -> Expr -> Expr -> Expr quadruple e1 e2 e3 e4 = cccE :$ e1 :$ e2 :$ e3 :$ e4 where cccE = value ",,," ((,,,) :: Int -> Int -> Int -> Int -> (Int,Int,Int,Int)) +-- | The quintuple constructor lifted over 'Expr's.+--+-- This only works for the 'Int' element type. quintuple :: Expr -> Expr -> Expr -> Expr -> Expr -> Expr quintuple e1 e2 e3 e4 e5 = ccccE :$ e1 :$ e2 :$ e3 :$ e4 :$ e5 where ccccE = value ",,,," ((,,,,) :: Int -> Int -> Int -> Int -> Int -> (Int,Int,Int,Int,Int)) +-- | The sixtuple constructor lifted over 'Expr's.+--+-- This only works for the 'Int' element type. sixtuple :: Expr -> Expr -> Expr -> Expr -> Expr -> Expr -> Expr sixtuple e1 e2 e3 e4 e5 e6 = cccccE :$ e1 :$ e2 :$ e3 :$ e4 :$ e5 :$ e6 where@@ -1301,9 +1546,22 @@ headOr x [] = x headOr _ (x:_) = x +-- | Function composition encoded as an 'Expr':+--+-- > > compose+-- > (.) :: (Int -> Int) -> (Int -> Int) -> Int -> Int compose :: Expr compose = value "." ((.) :: Compose Int) +-- | Function composition '.' lifted over 'Expr'.+--+-- > > absE -.- negateE+-- > abs . negate :: Int -> Int+--+-- > > absE -.- negateE :$ one+-- > (abs . negate) 1 :: Int+--+-- This works for 'Int', 'Bool', 'Char' and their lists. (-.-) :: Expr -> Expr -> Expr ex -.- ey = (:$ ey) . headOr err $ mapMaybe ($$ ex) [ value "." ((.) :: Compose ())@@ -1318,9 +1576,17 @@ err = error $ "(-.-): unhandled type " ++ show (typ ex) type Compose a = (a -> a) -> (a -> a) -> (a -> a) +-- | 'map' over the 'Int' element type encoded as an 'Expr'+--+-- > > mapE+-- > map :: (Int -> Int) -> [Int] -> [Int] mapE :: Expr mapE = value "map" (map :: Map Int) +-- | 'map' lifted over 'Expr's.+--+-- > > map' absE (unit one)+-- > map abs [1] :: [Int] map' :: Expr -> Expr -> Expr map' ef exs = (:$ exs) . headOr err $ mapMaybe ($$ ef) [ value "map" (map :: Map ())@@ -1335,6 +1601,12 @@ err = error $ "map': unhandled type " ++ show (typ ef) type Map a = (a -> a) -> [a] -> [a] +-- | 'enumFrom' lifted over 'Expr's.+--+-- > > enumFrom' zero+-- > enumFrom 0 :: [Int]+--+-- Works for 'Int's, 'Bool's and 'Char's. enumFrom' :: Expr -> Expr enumFrom' ex = headOr err $ mapMaybe ($$ ex) [ value "enumFrom" (enumFrom :: EnumFrom Int)@@ -1345,6 +1617,12 @@ err = error $ "enumFrom': unhandled type " ++ show (typ ex) type EnumFrom a = (a -> [a]) +-- | 'enumFrom' lifted over 'Expr's named as @".."@ for pretty-printing.+--+-- > > (-..) one+-- > [1..] :: [Int]+--+-- Works for 'Int's, 'Bool's and 'Char's. (-..) :: Expr -> Expr (-..) ex = headOr err $ mapMaybe ($$ ex) [ value ".." (enumFrom :: EnumFrom Int)@@ -1354,6 +1632,10 @@ where err = error $ "(-..): unhandled type " ++ show (typ ex) +-- | 'enumFromTo' lifted over 'Expr's+--+-- > > enumFromTo' zero four+-- > enumFromTo 0 4 :: [Int] enumFromTo' :: Expr -> Expr -> Expr enumFromTo' ex ey = (:$ ey) . headOr err $ mapMaybe ($$ ex) [ value "enumFromTo" (enumFromTo :: EnumFromTo Int)@@ -1364,6 +1646,10 @@ err = error $ "enumFromTo': unhandled type " ++ show (typ ex) type EnumFromTo a = (a -> a -> [a]) +-- | 'enumFromTo' lifted over 'Expr's but named as @".."@ for pretty-printing.+--+-- > > zero -..- four+-- > [0..4] :: [Int] (-..-) :: Expr -> Expr -> Expr ex -..- ey = (:$ ey) . headOr err $ mapMaybe ($$ ex) [ value ".." (enumFromTo :: EnumFromTo Int)@@ -1373,6 +1659,10 @@ where err = error $ "-..-: unhandled type " ++ show (typ ex) +-- | 'enumFromThen' lifted over 'Expr's+--+-- > > enumFromThen' zero ten+-- > enumFromThen 0 10 :: [Int] enumFromThen' :: Expr -> Expr -> Expr enumFromThen' ex ey = (:$ ey) . headOr err $ mapMaybe ($$ ex) [ value "enumFromThen" (enumFromThen :: EnumFromThen Int)@@ -1383,6 +1673,10 @@ err = error $ "enumFromThen': unhandled type " ++ show (typ ex) type EnumFromThen a = (a -> a -> [a]) +-- | 'enumFromThen' lifted over 'Expr's but named as @",.."@ for pretty printing.+--+-- > > zero -... ten+-- > [0,10..] :: [Int] (-...) :: Expr -> Expr -> Expr ex -... ey = (:$ ey) . headOr err $ mapMaybe ($$ ex) [ value ",.." (enumFromThen :: EnumFromThen Int)@@ -1392,6 +1686,10 @@ where err = error $ "-..-: unhandled type " ++ show (typ ex) +-- | 'enumFromThenTo' lifted over 'Expr's.+--+-- > > enumFromThenTo' zero two ten+-- > enumFromThenTo 0 2 10 :: [Int] enumFromThenTo' :: Expr -> Expr -> Expr -> Expr enumFromThenTo' ex ey ez = (:$ ez) . (:$ ey) . headOr err $ mapMaybe ($$ ex) [ value "enumFromThenTo" (enumFromThenTo :: EnumFromThenTo Int)@@ -1402,6 +1700,10 @@ err = error $ "enumFromThenTo': unhandled type " ++ show (typ ex) type EnumFromThenTo a = (a -> a -> a -> [a]) +-- | 'enumFromThenTo' lifted over 'Expr's but named as @",.."@ for pretty-printing.+--+-- > > (zero -...- two) ten+-- > [0,2..10] :: [Int] (-...-) :: Expr -> Expr -> Expr -> Expr (ex -...- ey) ez = (:$ ez) . (:$ ey) . headOr err $ mapMaybe ($$ ex) [ value ",.." (enumFromThenTo :: EnumFromThenTo Int)
src/Data/Express/Fold.hs view
@@ -5,7 +5,10 @@ -- Maintainer : Rudy Matela <rudy@matela.com.br> -- -- Defines utilities for folding and unfolding 'Expr's.-{-# LANGUAGE DeriveDataTypeable #-} -- for GHC <= 7.8+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ == 708+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+#endif module Data.Express.Fold ( fold , unfold@@ -19,10 +22,9 @@ where import Data.Express.Core-import Data.Typeable (Typeable) -- for GHC <= 7.8+import Data.Express.Utils.Typeable data ExprPair = ExprPair- deriving Typeable -- for GHC <= 7.8 -- | /O(n)/. -- Folds a list of 'Expr' with function application (':$').@@ -48,7 +50,8 @@ -- Folds a pair of 'Expr' values into a single 'Expr'. -- (cf. 'unfoldPair') ----- This /always/ generates an ill-typed expression.+-- This /always/ generates an ill-typed expression,+-- as it uses a fake pair constructor. -- -- > > foldPair (val False, val (1::Int)) -- > (False,1) :: ill-typed # ExprPair $ Bool #@@ -82,18 +85,49 @@ unfoldPair _ = error "unfoldPair: not an Expr pair" data ExprTrio = ExprTrio- deriving Typeable -- for GHC <= 7.8 +-- | /O(1)/.+-- Folds a trio/triple of 'Expr' values into a single 'Expr'.+-- (cf. 'unfoldTrio')+--+-- This /always/ generates an ill-typed expression+-- as it uses a fake trio/triple constructor.+--+-- > > foldTrio (val False, val (1::Int), val 'a')+-- > (False,1,'a') :: ill-typed # ExprTrio $ Bool #+--+-- > > foldTrio (val (0::Int), val True, val 'b')+-- > (0,True,'b') :: ill-typed # ExprTrio $ Int #+--+-- This is useful when applying transformations on pairs of 'Expr's, such as+-- 'Data.Express.Canon.canonicalize',+-- 'Data.Express.Map.mapValues' or+-- 'Data.Express.Canon.canonicalVariations'.+--+-- > > let ii = var "i" (undefined::Int)+-- > > let kk = var "k" (undefined::Int)+-- > > let zz = var "z" (undefined::Int)+-- > > unfoldPair $ canonicalize $ foldPair (ii,kk,zz)+-- > (x :: Int,y :: Int,z :: Int) foldTrio :: (Expr,Expr,Expr) -> Expr foldTrio (e1,e2,e3) = value ",," (undefined :: ExprTrio) :$ e1 :$ e2 :$ e3 +-- | /O(1)/.+-- Unfolds an 'Expr' representing a trio/triple.+-- This reverses the effect of 'foldTrio'.+--+-- > > value ",," ((,,) :: Bool->Bool->Bool->(Bool,Bool,Bool)) :$ val True :$ val False :$ val True+-- > (True,False,True) :: (Bool,Bool,Bool)+-- > > unfoldTrio $ value ",," ((,,) :: Bool->Bool->Bool->(Bool,Bool,Bool)) :$ val True :$ val False :$ val True+-- > (True :: Bool,False :: Bool,True :: Bool)+--+-- (cf. 'unfoldPair') unfoldTrio :: Expr -> (Expr,Expr,Expr) unfoldTrio (Value ",," _ :$ e1 :$ e2 :$ e3) = (e1,e2,e3) unfoldTrio (Value "(,,)" _ :$ e1 :$ e2 :$ e3) = (e1,e2,e3) unfoldTrio _ = error "unfoldTrio: not an Expr trio" data ExprList = ExprList- deriving Typeable -- for GHC <= 7.8 -- | /O(n)/. -- Folds a list of 'Expr's into a single 'Expr'.@@ -131,3 +165,9 @@ unfold (Value "[]" _) = [] unfold (Value ":" _ :$ e :$ es) = e : unfold es unfold e = error $ "unfold: cannot unfold expression: " ++ show e++#if __GLASGOW_HASKELL__ == 708+deriving instance Typeable ExprPair+deriving instance Typeable ExprTrio+deriving instance Typeable ExprList+#endif
src/Data/Express/Instances.hs view
@@ -49,8 +49,6 @@ ) where --- TODO: document and test functions of the Instances module- import Data.Express.Basic import Data.Express.Name import Data.Express.Express@@ -118,8 +116,6 @@ reifyName :: (Typeable a, Name a) => a -> [Expr] reifyName a = mkName (name -:> a) --- todo: reifyExpr and related functions- -- | /O(1)/. -- Builds a reified 'Eq' instance from the given '==' function. -- (cf. 'reifyEq')@@ -175,6 +171,9 @@ -- searching for functions -- +-- | /O(n)./+-- Lookups for a comparison function (@:: a -> a -> Bool@)+-- with the given name and argument type. lookupComparison :: String -> TypeRep -> [Expr] -> Maybe Expr lookupComparison n' t = find (\i@(Value n _) -> n == n' && typ i == mkComparisonTy t) @@ -256,6 +255,11 @@ isEqOrd :: [Expr] -> Expr -> Bool isEqOrd is e = isEq is e && isOrd is e +-- | /O(n+m)./+-- Like 'mkEquation', 'mkComparisonLE' and 'mkComparisonLT'+-- but allows providing the binary operator name.+--+-- When not possible, this function returns 'False' encoded as an 'Expr'. mkComparison :: String -> [Expr] -> Expr -> Expr -> Expr mkComparison n' is e1 e2 = fromMaybe (val False) $ do e1e <- findValidApp os e1@@ -263,15 +267,46 @@ where os = [eq | eq@(Value n _) <- is, n == n'] +-- | /O(n+m)./+-- Returns an equation between two expressions+-- given that it is possible to do so from '==' operators+-- given in the argument instances list.+--+-- When not possible, this function returns 'False' encoded as an 'Expr'. mkEquation :: [Expr] -> Expr -> Expr -> Expr mkEquation = mkComparison "==" +-- | /O(n+m)./+-- Returns a less-than inequation between two expressions+-- given that it is possible to do so from '<' operators+-- given in the argument instances list.+--+-- When not possible, this function returns 'False' encoded as an 'Expr'. mkComparisonLT :: [Expr] -> Expr -> Expr -> Expr mkComparisonLT = mkComparison "<" +-- | /O(n+m)./+-- Returns a less-than-or-equal-to inequation between two expressions+-- given that it is possible to do so from '<=' operators+-- given in the argument instances list.+--+-- When not possible, this function returns 'False' encoded as an 'Expr'. mkComparisonLE :: [Expr] -> Expr -> Expr -> Expr mkComparisonLE = mkComparison "<=" +-- | /O(n+m)./+-- Like 'name' but lifted over an instance list and an 'Expr'.+--+-- > > lookupName preludeNameInstances (val False)+-- > "p"+--+-- > > lookupName preludeNameInstances (val (0::Int))+-- > "x"+--+-- This function defaults to @"x"@ when no appropriate 'name' is found.+--+-- > > lookupName [] (val False)+-- > "x" lookupName :: [Expr] -> Expr -> String lookupName is e = fromMaybe d $ eval "x" <$> findValidApp es e where@@ -280,18 +315,29 @@ | otherwise = 'x' : replicate (countListTy t) 's' es = [e | e@(Value "name" _) <- is] +-- | /O(n+m)./+-- A mix between 'lookupName' and 'names':+-- this returns an infinite list of names+-- based on an instances list and an 'Expr'. lookupNames :: [Expr] -> Expr -> [String] lookupNames is = variableNamesFromTemplate . lookupName is +-- | /O(n+m)./+-- Like 'lookupNames' but returns a list of variables encoded as 'Expr's. listVarsWith :: [Expr] -> Expr -> [Expr] listVarsWith is e = lookupName is e `listVarsAsTypeOf` e -- helpers -- +-- |+-- Given a list of functional expressions and another expression,+-- returns a list of valid applications. validApps :: [Expr] -> Expr -> [Expr] validApps es e = mapMaybe ($$ e) es +-- |+-- Like 'validApps' but returns a 'Maybe' value. findValidApp :: [Expr] -> Expr -> Maybe Expr findValidApp es = listToMaybe . validApps es @@ -302,6 +348,9 @@ -- reified instances -- +-- |+-- A list of reified 'Name' instances+-- for an arbitrary selection of types from the Haskell "Prelude". preludeNameInstances :: [Expr] preludeNameInstances = concat [ reifyName (u :: ())
src/Data/Express/Match.hs view
@@ -15,10 +15,8 @@ ) where -import Data.Express.Basic-import Data.Maybe-import Data.Functor ((<$>))-import Control.Monad ((>=>))+import Data.Express.Core+import Data.Express.Utils -- | -- Given two expressions, returns a 'Just' list of matches
src/Data/Express/Triexpr.hs view
@@ -38,17 +38,23 @@ ) where -import Data.Express+import Data.Express.Core+import Data.Express.Match import Data.Maybe import Prelude hiding (map, lookup) --- "Nothing" should match an App, "Just Expr" an expression+-- | A trie of 'Expr's.+--+-- In the representation,+-- 'Nothing' matches an App and 'Just' 'Expr' an expression. data Triexpr a = Triexpr [(Maybe Expr, Either (Triexpr a) (Expr,a))] deriving (Eq, Ord, Show) +-- | An empty 'Triexpr'. empty :: Triexpr a empty = Triexpr [] +-- | Constructs a 'Triexpr' encoding a single expression. unit :: Expr -> a -> Triexpr a unit e x = u e (Right (e,x)) where@@ -56,6 +62,7 @@ u (e1 :$ e2) et = Triexpr [(Nothing, Left $ u e1 $ Left $ u e2 et)] u e et = Triexpr [(Just e, et)] +-- | Merges two 'Triexpr's. merge :: Triexpr a -> Triexpr a -> Triexpr a merge (Triexpr ms1) (Triexpr ms2) = Triexpr $ m ms1 ms2 where@@ -68,18 +75,22 @@ (Left t1, Left t2) -> (e1, Left $ t1 `merge` t2) : m ms1 ms2 (_,_) -> (e1,mt1) : (e2,mt2) : m ms1 ms2 +-- | Inserts an 'Expr' into a 'Triexpr'. insert :: Expr -> a -> Triexpr a -> Triexpr a insert e x t = unit e x `merge` t +-- | List all 'Expr' stored in a 'Triexpr' along with their associated values. toList :: Triexpr a -> [(Expr, a)] toList (Triexpr ms) = concatMap to ms where to (_, Right ex) = [ex] to (_, Left t) = toList t +-- | Constructs a 'Triexpr' form a list of key 'Expr's and associated values. fromList :: [(Expr, a)] -> Triexpr a fromList = foldr (uncurry insert) empty +-- | Maps a function to the stored values in a 'Triexpr'. map :: (a -> b) -> Triexpr a -> Triexpr b map f (Triexpr ms) = Triexpr [(ex, mapEither (map f) (mapSnd f) eth) | (ex, eth) <- ms] where@@ -89,6 +100,7 @@ mapSnd :: (a -> b) -> (c,a) -> (c,b) mapSnd f (x,y) = (x, f y) +-- | Performs a lookup in a 'Triexpr'. lookup :: Expr -> Triexpr a -> [ (Expr, [(Expr,Expr)], a) ] lookup e t = [(e, bs, x) | (bs, Right (e,x)) <- look (Just e) t []] where
+ src/Data/Express/Utils.hs view
@@ -0,0 +1,46 @@+-- |+-- Module : Data.Express.Utils.List+-- Copyright : (c) 2019-2021 Rudy Matela+-- License : 3-Clause BSD (see the file LICENSE)+-- Maintainer : Rudy Matela <rudy@matela.com.br>+--+-- Re-exports a few standard Haskell modules module along with additional+-- functions.+{-# LANGUAGE CPP #-}+module Data.Express.Utils+ ( module Data.Express.Utils.List+ , module Data.Express.Utils.String+ , module Data.Monoid+ , module Data.Maybe+ , module Data.Either+ , module Data.Function+ , module Control.Monad+#if __GLASGOW_HASKELL__ < 704+ , (<>)+#endif+#if __HUGS__+ , (>=>)+#endif+ )+where++import Data.Express.Utils.List+import Data.Express.Utils.String+import Data.Function+import Data.Maybe+import Data.Either+import Data.Monoid+import Control.Monad++#if __GLASGOW_HASKELL__ < 704+-- Data.Monoid exports <> since GHC 7.4 / base 4.5.0.0+-- GHC 7.2 / base 4.4.1.0 / Hugs 2006.9 do not define <>+(<>) :: Monoid m => m -> m -> m+(<>) = mappend+infixr 6 <>+#endif++#if __HUGS__+(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)+f >=> g = \x -> f x >>= g+#endif
src/Data/Express/Utils/List.hs view
@@ -19,6 +19,9 @@ #if __GLASGOW_HASKELL__ < 710 , isSubsequenceOf #endif+#ifdef __HUGS__+ , intercalate+#endif ) where @@ -46,6 +49,7 @@ nnub [x] = [x] nnub (x:xs) = x : nnub (dropWhile (==x) xs) +-- | Like 'nubSort' but allows providing a function to 'compare' values. nubSortBy :: (a -> a -> Ordering) -> [a] -> [a] nubSortBy cmp = nnub . sortBy cmp where@@ -100,10 +104,17 @@ lookupId :: Eq a => a -> [(a,a)] -> a lookupId x = fromMaybe x . lookup x +-- | Merges two lists discarding repeated elements.+--+-- The argument lists need to be in order.+--+-- > > [1,10,100] +++ [9,10,11]+-- > [1,9,10,11,100] (+++) :: Ord a => [a] -> [a] -> [a] (+++) = nubMerge infixr 5 +++ +-- | Like 'nubMerge' but allows providing a function to 'compare' values. nubMergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a] nubMergeBy cmp (x:xs) (y:ys) = case x `cmp` y of LT -> x:nubMergeBy cmp xs (y:ys)@@ -111,5 +122,21 @@ EQ -> x:nubMergeBy cmp xs ys nubMergeBy _ xs ys = xs ++ ys +-- | Merges two lists discarding repeated elements.+--+-- The argument lists need to be in order. nubMerge :: Ord a => [a] -> [a] -> [a] nubMerge = nubMergeBy compare++#ifdef __HUGS__+intercalate :: [a] -> [[a]] -> [a]+intercalate xs xss = concat (intersperse xs xss)+ where+ intersperse :: a -> [a] -> [a]+ intersperse _ [] = []+ intersperse sep (x:xs) = x : prependToAll sep xs+ where+ prependToAll :: a -> [a] -> [a]+ prependToAll _ [] = []+ prependToAll sep (x:xs) = sep : x : prependToAll sep xs+#endif
src/Data/Express/Utils/String.hs view
@@ -8,8 +8,7 @@ -- -- At some point, this file was part of the Speculate tool. module Data.Express.Utils.String- ( module Data.String- , module Data.Char+ ( module Data.Char , unquote , atomic , outernmostPrec@@ -22,14 +21,13 @@ ) where -import Data.String import Data.Char-import Data.Functor ((<$>)) -- for GHC < 7.10 -- | Unquotes a string if possible, otherwise, this is just an identity. -- -- > > unquote "\"string\"" -- > "string"+-- -- > > unquote "something else" -- > "something else" unquote :: String -> String@@ -67,12 +65,28 @@ atomic ('(':s) | last s == ')' = True atomic _ = False +-- |+-- Returns the operator precedence of an infix string.+--+-- > > outernmostPrec "1 + 2"+-- > Just 6 outernmostPrec :: String -> Maybe Int outernmostPrec s = case words s of [l,o,r] | isInfix o -> Just (prec o) _ -> Nothing +-- |+-- Returns whether the given 'String' represents a negative literal.+--+-- > > isNegativeLiteral "1"+-- > False+-- > > isNegativeLiteral "-1"+-- > True+-- > > isNegativeLiteral "-x"+-- > False+-- > > isNegativeLiteral "1 - 3"+-- > False isNegativeLiteral :: String -> Bool isNegativeLiteral s | not (atomic s) = False isNegativeLiteral "-" = False@@ -124,6 +138,13 @@ prec "<==>" = 0 prec _ = 9 +-- | Is the given string a prefix function?+--+-- > > isPrefix "abs"+-- > True+--+-- > > isPrefix "+"+-- > False isPrefix :: String -> Bool isPrefix = not . isInfix @@ -141,6 +162,12 @@ toPrefix ('`':cs) = init cs toPrefix cs = '(':cs ++ ")" +-- |+-- Cycles through a list of variable names+-- priming them at each iteration.+--+-- > primeCycle ["x","y","z"]+-- ["x","y","z","x'","y'","z'","x''","y''","z''","x'''",...] primeCycle :: [String] -> [String] primeCycle [] = [] primeCycle ss = ss ++ map (++ "'") (primeCycle ss)@@ -165,7 +192,7 @@ f "xyz" = ["xyz", "uvw"] f cs | isDigit (last cs) = map (\n -> init cs ++ show n) [digitToInt (last cs)..] f [c] | c `elem` ['a'..'x'] = let x = ord c in map ((:[]) . chr) [x,x+1,x+2]- f cs | last cs == 's' = (++ "s") <$> f (init cs)+ f cs | last cs == 's' = (++ "s") `map` f (init cs) f [c,d] | ord d - ord c == 1 = [[c,d], [chr $ ord c + 2, chr $ ord d + 2]] f cs | cs == "y" || cs == "z" = cs : map (\n -> cs ++ show n) [1..] f cs = [cs]
src/Data/Express/Utils/TH.hs view
@@ -55,6 +55,18 @@ else reallyDerive t +-- |+-- Encodes a 'Name' as a 'String'.+-- This is useful when generating error messages.+--+-- > > showJustName ''Int+-- > "Int"+--+-- > > showJustName ''String+-- > "String"+--+-- > > showJustName ''Maybe+-- > "Maybe" showJustName :: Name -> String showJustName = reverse . takeWhile (/= '.') . reverse . show @@ -99,17 +111,22 @@ tss <- mapM (`typeConCascadingArgsThat` p') ts return $ nubMerges (ts:tss) --- Normalizes a type by applying it to necessary type variables, making it--- accept "zero" parameters. The normalized type is tupled with a list of--- necessary type variables.+-- |+-- Normalizes a type by applying it to necessary type variables+-- making it accept zero type parameters.+-- The normalized type is paired with a list of necessary type variables. ----- Suppose:+-- > > putStrLn $(stringE . show =<< normalizeType ''Int)+-- > (ConT ''Int, []) ----- > data DT a b c ... = ...+-- > > putStrLn $(stringE . show =<< normalizeType ''Maybe)+-- > (AppT (ConT ''Maybe) (VarT ''a),[VarT ''a]) ----- Then, in pseudo-TH:+-- > > putStrLn $(stringE . show =<< normalizeType ''Either)+-- > (AppT (AppT (ConT ''Either) (VarT ''a)) (VarT ''b),[VarT ''a,VarT ''b]) ----- > normalizeType [t|DT|] == Q (DT a b c ..., [a, b, c, ...])+-- > > putStrLn $(stringE . show =<< normalizeType ''[])+-- > (AppT (ConT ''[]) (VarT a),[VarT a]) normalizeType :: Name -> Q (Type, [Type]) normalizeType t = do ar <- typeArity t@@ -122,35 +139,59 @@ newVarTs n = liftM (map VarT) $ newNames (take n . map (:[]) $ cycle ['a'..'z']) --- Normalizes a type by applying it to units (`()`) while possible.------ > normalizeTypeUnits ''Int === [t| Int |]--- > normalizeTypeUnits ''Maybe === [t| Maybe () |]--- > normalizeTypeUnits ''Either === [t| Either () () |]+-- |+-- Normalizes a type by applying it to units to make it star-kinded.+-- (cf. 'normalizeType') normalizeTypeUnits :: Name -> Q Type normalizeTypeUnits t = do ar <- typeArity t return (foldl AppT (ConT t) (replicate ar (TupleT 0))) +-- | -- Given a type name and a class name, -- returns whether the type is an instance of that class.+-- The given type must be star-kinded (@ * @)+-- and the given class double-star-kinded (@ * -> * @.+--+-- > > putStrLn $(stringE . show =<< ''Int `isInstanceOf` ''Num)+-- > True+--+-- > > putStrLn $(stringE . show =<< ''Int `isInstanceOf` ''Fractional)+-- > False isInstanceOf :: Name -> Name -> Q Bool isInstanceOf tn cl = do ty <- normalizeTypeUnits tn isInstance cl [ty] +-- |+-- The negation of 'isInstanceOf'. isntInstanceOf :: Name -> Name -> Q Bool isntInstanceOf tn cl = liftM not (isInstanceOf tn cl) -- | Given a type name, return the number of arguments taken by that type. -- Examples in partially broken TH: ----- > arity ''Int === Q 0--- > arity ''Int->Int === Q 0--- > arity ''Maybe === Q 1--- > arity ''Either === Q 2--- > arity ''Int-> === Q 1+-- > > putStrLn $(stringE . show =<< typeArity ''Int)+-- > 0 --+-- > > putStrLn $(stringE . show =<< typeArity ''Maybe)+-- > 1+--+-- > > putStrLn $(stringE . show =<< typeArity ''Either)+-- > 2+--+-- > > putStrLn $(stringE . show =<< typeArity ''[])+-- > 1+--+-- > > putStrLn $(stringE . show =<< typeArity ''(,))+-- > 2+--+-- > > putStrLn $(stringE . show =<< typeArity ''(,,))+-- > 3+--+-- > > putStrLn $(stringE . show =<< typeArity ''String)+-- > 0+-- -- This works for Data's and Newtype's and it is useful when generating -- typeclass instances. typeArity :: Name -> Q Int@@ -168,20 +209,28 @@ _ -> error $ "error (typeArity): symbol " ++ show t ++ " is not a newtype, data or type synonym" --- Given a type name, returns a list of its type constructor names paired with+-- |+-- Given a type 'Name',+-- returns a list of its type constructor 'Name's+-- paired with the type arguments they take. -- the type arguments they take. ----- > typeConstructors ''() === Q [('(),[])]------ > typeConstructors ''(,) === Q [('(,),[VarT a, VarT b])]+-- > > putStrLn $(stringE . show =<< typeConstructors ''Bool)+-- > [ ('False, [])+-- > , ('True, [])+-- > ] ----- > typeConstructors ''[] === Q [('[],[]),('(:),[VarT a,AppT ListT (VarT a)])]+-- > > putStrLn $(stringE . show =<< typeConstructors ''[])+-- > [ ('[], [])+-- > , ('(:), [VarT ''a, AppT ListT (VarT ''a)])+-- > ] ----- > data Pair a = P a a--- > typeConstructors ''Pair === Q [('P,[VarT a, VarT a])]+-- > > putStrLn $(stringE . show =<< typeConstructors ''(,))+-- > [('(,), [VarT (mkName "a"), VarT (mkName "b")])] ----- > data Point = Pt Int Int--- > typeConstructors ''Point === Q [('Pt,[ConT Int, ConT Int])]+-- > > data Point = Pt Int Int+-- > > putStrLn $(stringE . show =<< typeConstructors ''Point)+-- > [('Pt,[ConT ''Int, ConT ''Int])] typeConstructors :: Name -> Q [(Name,[Type])] typeConstructors t = do ti <- reify t@@ -201,6 +250,17 @@ simplify (InfixC t1 n t2) = (n,[snd t1,snd t2]) trd (x,y,z) = z +-- |+-- Is the given 'Name' a type synonym?+--+-- > > putStrLn $(stringE . show =<< isTypeSynonym 'show)+-- > False+--+-- > > putStrLn $(stringE . show =<< isTypeSynonym ''Char)+-- > False+--+-- > > putStrLn $(stringE . show =<< isTypeSynonym ''String)+-- > True isTypeSynonym :: Name -> Q Bool isTypeSynonym t = do ti <- reify t@@ -208,6 +268,11 @@ TyConI (TySynD _ _ _) -> True _ -> False +-- |+-- Resolves a type synonym.+--+-- > > putStrLn $(stringE . show =<< typeSynonymType ''String)+-- > AppT ListT (ConT ''Char) typeSynonymType :: Name -> Q Type typeSynonymType t = do ti <- reify t@@ -286,6 +351,11 @@ return (c,ns) | (c,ts) <- cs ] +-- | Lookups the name of a value+-- throwing an error when it is not found.+--+-- > > putStrLn $(stringE . show =<< lookupValN "show")+-- > 'show lookupValN :: String -> Q Name lookupValN s = do mn <- lookupValueName s
src/Data/Express/Utils/Typeable.hs view
@@ -31,15 +31,23 @@ where import Data.Typeable-import Data.Monoid ((<>))-import Data.Express.Utils.List+import Data.Express.Utils --- Different versions of Typeable/GHC provide different orderings for TypeReps.--- The following is a version independent ordering, with the following--- properties:+-- | Compares two 'TypeRep's. --+-- Different versions of Typeable/GHC+-- provide different orderings for 'TypeRep's.+-- The following is a version independent ordering,+-- with the following properties:+-- -- * functional types with more arguments are larger; -- * type constructors with more arguments are larger.+--+-- > > typeOf (undefined :: Int -> Int) `compareTy` typeOf (undefined :: () -> () -> ())+-- > LT+--+-- > > typeOf (undefined :: Int) `compareTy` typeOf (undefined :: ())+-- > GT compareTy :: TypeRep -> TypeRep -> Ordering compareTy t1 t2 | t1 == t2 = EQ -- optional optimization compareTy t1 t2 = tyArity t1 `compare` tyArity t2@@ -50,24 +58,71 @@ (c1,ts1) = splitTyConApp t1 (c2,ts2) = splitTyConApp t2 +-- | Returns the functional arity of the given 'TypeRep'.+--+-- > > tyArity $ typeOf (undefined :: Int)+-- > 0+--+-- > > tyArity $ typeOf (undefined :: Int -> Int)+-- > 1+--+-- > > tyArity $ typeOf (undefined :: (Int,Int))+-- > 0 tyArity :: TypeRep -> Int tyArity t | isFunTy t = 1 + tyArity (resultTy t) | otherwise = 0 +-- | Returns the ultimate result type of the given 'TypeRep'.+--+-- > > finalResultTy (typeOf (undefined :: Int))+-- > Int+--+-- > > finalResultTy (typeOf (undefined :: Int -> Char))+-- > Char+--+-- > > finalResultTy (typeOf (undefined :: Int -> Char -> Bool))+-- > Bool finalResultTy :: TypeRep -> TypeRep finalResultTy t | isFunTy t = finalResultTy (resultTy t) | otherwise = t +-- | Deconstructs a functional 'TypeRep' into a pair of 'TypeRep's.+--+-- > > unFunTy $ typeOf (undefined :: Int -> Char -> Bool)+-- > (Int,Char -> Bool)+--+-- This function raises an error on non-functional types.+--+-- (cf. 'argumentTy' and 'resultTy') unFunTy :: TypeRep -> (TypeRep,TypeRep) unFunTy t | isFunTy t = let (f,[a,b]) = splitTyConApp t in (a,b) | otherwise = error $ "error (unFunTy): `" ++ show t ++ "` is not a function type" +-- | Returns the argument 'TypeRep' of a given functional 'TypeRep'.+--+-- > argumentTy $ typeOf (undefined :: Int -> Char)+-- > Int+--+-- This function raises an error on non-functional types.+--+-- (cf. 'resultTy') argumentTy :: TypeRep -> TypeRep argumentTy = fst . unFunTy +-- | Returns the result 'TypeRep' of a given functional 'TypeRep'.+--+-- > > resultTy $ typeOf (undefined :: Int -> Char)+-- > Char+--+-- > > resultTy $ typeOf (undefined :: Int -> Char -> Bool)+-- > Char -> Bool+--+-- This function raises an error on non-functional types.+--+-- (cf. 'argumentTy' and 'finalResultTy') resultTy :: TypeRep -> TypeRep resultTy = snd . unFunTy @@ -87,21 +142,32 @@ | isListTy t = let (_,[a]) = splitTyConApp t in a | otherwise = error $ "error (elementTy): `" ++ show t ++ "' is not a list type" +-- | The 'Bool' type encoded as a 'TypeRep'. boolTy :: TypeRep boolTy = typeOf (undefined :: Bool) +-- | The 'Int' type encoded as a 'TypeRep'. intTy :: TypeRep intTy = typeOf (undefined :: Int) +-- | The 'Ordering' type encoded as a 'TypeRep'. orderingTy :: TypeRep orderingTy = typeOf (undefined :: Ordering) +-- | The function type constructor as a 'TyCon' funTyCon :: TyCon funTyCon = typeRepTyCon $ typeOf (undefined :: () -> ()) +-- | The list type constructor as a 'TyCon' listTyCon :: TyCon listTyCon = typeRepTyCon $ typeOf (undefined :: [()]) +-- | Returns whether a 'TypeRep' is functional.+--+-- > > isFunTy $ typeOf (undefined :: Int -> Int)+-- > True+-- > > isFunTy $ typeOf (undefined :: Int)+-- > False isFunTy :: TypeRep -> Bool isFunTy t = case splitTyConApp t of@@ -113,14 +179,47 @@ (con,[_]) | con == listTyCon -> True _ -> False +-- | Return the number of outer list nestings in a 'TypeRep'+--+-- > > countListTy $ typeOf (undefined :: Int)+-- > 0+--+-- > > countListTy $ typeOf (undefined :: [Bool])+-- > 1+--+-- > > countListTy $ typeOf (undefined :: [[()]])+-- > 2+--+-- > > countListTy $ typeOf (undefined :: String)+-- > 1+--+-- > > countListTy $ typeOf (undefined :: ([Int],[Bool]))+-- > 0 countListTy :: TypeRep -> Int countListTy t = case splitTyConApp t of (con,[t']) | con == listTyCon -> 1 + countListTy t' _ -> 0 +-- | Constructs a comparison type (@ a -> a -> Bool @)+-- from the given argument type.+--+-- > > mkComparisonTy $ typeOf (undefined :: Int)+-- > Int -> Int -> Bool+--+-- > > mkComparisonTy $ typeOf (undefined :: ())+-- > () -> () -> Bool mkComparisonTy :: TypeRep -> TypeRep mkComparisonTy a = a ->:: a ->:: boolTy +-- | Constructs a "compare" type (@ a -> a -> Ordering @)+-- from the given argument type.+--+-- > > mkCompareTy $ typeOf (undefined :: Int)+-- > Int -> Int -> Ordering+--+-- > > mkCompareTy $ typeOf (undefined :: ())+-- > () -> () -> Ordering+ mkCompareTy :: TypeRep -> TypeRep mkCompareTy a = a ->:: a ->:: orderingTy @@ -158,6 +257,13 @@ typesIn :: TypeRep -> [TypeRep] typesIn t = typesInList [t] +-- | Returns types and subtypes from the given list of 'TypeRep's.+--+-- > > typesInList [typeOf (undefined :: () -> Int), typeOf (undefined :: String -> String -> Bool)]+-- > [(),Bool,Char,Int,[Char],() -> Int,[Char] -> Bool,[Char] -> [Char] -> Bool]+--+-- > > typesInList [typeOf (undefined :: (Char,Int))]+-- > [Char,Int,(Char,Int)] typesInList :: [TypeRep] -> [TypeRep] typesInList ts = nubSortBy compareTy $ tins ts [] where
test/Test/ListableExpr.hs view
@@ -50,8 +50,6 @@ ) where --- TODO: StringE- import Test.LeanCheck import Test.LeanCheck.Function.ShowFunction import Data.Express.Fixtures
+ test/typecheck.hs view
@@ -0,0 +1,19 @@+-- test/typecheck.hs: imports Express and does nothing+--+-- to be used for triggering typechecking using runhugs+--+-- Copyright (c) 2019-2021 Rudy Matela.+-- Distributed under the 3-Clause BSD licence (see the file LICENSE).+import Data.Express.Core+import Data.Express.Hole+import Data.Express.Map+import Data.Express.Match++import Data.Express.Name+import Data.Express.Triexpr++import Data.Express.Utils+import Data.Express.Utils.Typeable++main :: IO ()+main = return ()