Map in Syntax

phadej · Mar 21, 2018 · 4288df6 · 4288df6
1 parent 9f621a2
commit 4288df6
Show file tree

Hide file tree

Showing 4 changed files with 83 additions and 57 deletions.
diff --git a/.travis.yml b/.travis.yml
@@ -1,6 +1,6 @@
 # This Travis job script has been generated by a script via
 #
-#   make_travis_yml_2.hs '--branch' 'master' 'spdx.cabal'
+#   runghc make_travis_yml_2.hs '--output' '.travis.yml' '--branch' 'master' 'spdx.cabal'
 #
 # For more information, see https://github.com/hvr/multi-ghc-travis
 #
@@ -28,6 +28,8 @@ before_cache:
   - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar
   - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx
 
+  - rm -rfv $HOME/.cabal/packages/head.hackage
+
 matrix:
   include:
     - compiler: "ghc-7.4.2"
@@ -45,51 +47,72 @@ matrix:
     - compiler: "ghc-8.0.2"
     # env: TEST=--disable-tests BENCH=--disable-benchmarks
       addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}
-    - compiler: "ghc-8.2.1"
+    - compiler: "ghc-8.2.2"
+    # env: TEST=--disable-tests BENCH=--disable-benchmarks
+      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}}
+    - compiler: "ghc-8.4.1"
     # env: TEST=--disable-tests BENCH=--disable-benchmarks
-      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}}
+      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}}
 
 before_install:
- - HC=${CC}
- - unset CC
- - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH
- - PKGNAME='spdx'
+  - HC=${CC}
+  - HCPKG=${HC/ghc/ghc-pkg}
+  - unset CC
+  - ROOTDIR=$(pwd)
+  - mkdir -p $HOME/.local/bin
+  - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH"
+  - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))
+  - echo $HCNUMVER
 
 install:
- - cabal --version
- - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
- - BENCH=${BENCH---enable-benchmarks}
- - TEST=${TEST---enable-tests}
- - travis_retry cabal update -v
- - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
- - rm -fv cabal.project.local
- - "echo 'packages: .' > cabal.project"
- - rm -f cabal.project.freeze
- - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all
- - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all
+  - cabal --version
+  - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
+  - BENCH=${BENCH---enable-benchmarks}
+  - TEST=${TEST---enable-tests}
+  - HADDOCK=${HADDOCK-true}
+  - INSTALLED=${INSTALLED-true}
+  - GHCHEAD=${GHCHEAD-false}
+  - travis_retry cabal update -v
+  - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"
+  - rm -fv cabal.project cabal.project.local
+  - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
+  - "printf 'packages: \".\"\\n' > cabal.project"
+  - cat cabal.project
+  - if [ -f "./configure.ac" ]; then
+      (cd "." && autoreconf -i);
+    fi
+  - rm -f cabal.project.freeze
+  - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all
+  - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all
+  - rm -rf .ghc.environment.* "."/dist
+  - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
 
 # Here starts the actual work to be performed for the package under test;
 # any command which exits with a non-zero exit code causes the build to fail.
 script:
- - if [ -f configure.ac ]; then autoreconf -i; fi
- - rm -rf .ghc.environment.* dist/
- - cabal sdist # test that a source-distribution can be generated
- - cd dist/
- - SRCTAR=(${PKGNAME}-*.tar.gz)
- - SRC_BASENAME="${SRCTAR/%.tar.gz}"
- - tar -xvf "./$SRC_BASENAME.tar.gz"
- - cd "$SRC_BASENAME/"
-## from here on, CWD is inside the extracted source-tarball
- - rm -fv cabal.project.local
- - "echo 'packages: .' > cabal.project"
- # this builds all libraries and executables (without tests/benchmarks)
- - rm -f cabal.project.freeze
- - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all
- # this builds all libraries and executables (including tests/benchmarks)
- # - rm -rf ./dist-newstyle
+  # test that source-distributions can be generated
+  - (cd "." && cabal sdist)
+  - mv "."/dist/spdx-*.tar.gz ${DISTDIR}/
+  - cd ${DISTDIR} || false
+  - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
+  - "printf 'packages: spdx-*/*.cabal\\n' > cabal.project"
+  - cat cabal.project
+  # this builds all libraries and executables (without tests/benchmarks)
+  - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all
+
+  # Build with installed constraints for packages in global-db
+  - if $INSTALLED; then echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh; else echo "Not building with installed constraints"; fi
+
+  # build & run tests, build benchmarks
+  - cabal new-build -w ${HC} ${TEST} ${BENCH} all
+  - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi
+
+  # cabal check
+  - (cd spdx-* && cabal check)
 
- # build & run tests
- - cabal new-build -w ${HC} ${TEST} ${BENCH} all
- - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi
+  # haddock
+  - rm -rf ./dist-newstyle
+  - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi
 
+# REGENDATA ["--output",".travis.yml","--branch","master","spdx.cabal"]
 # EOF
diff --git a/spdx-data/spdx-dev.cabal b/spdx-data/spdx-dev.cabal
@@ -15,8 +15,8 @@ cabal-version:       >=1.10
 executable spdx-data
   main-is:             Main.hs
   build-depends:
-    base >=4.9 && <4.11,
+    base >=4.9 && <4.12,
     bytestring,
-    cassava >=0.4.5.1 && <0.5
+    cassava >=0.4.5.1 && <0.6
   ghc-options:         -Wall -Werror
   default-language:    Haskell2010
diff --git a/spdx.cabal b/spdx.cabal
@@ -18,7 +18,8 @@ tested-with:
   GHC==7.8.4,
   GHC==7.10.3,
   GHC==8.0.2,
-  GHC==8.2.1
+  GHC==8.2.2,
+  GHC==8.4.1
 
 source-repository head
   type: git
@@ -42,7 +43,7 @@ library
     other-extensions:  DeriveGeneric
   hs-source-dirs:      src/
   ghc-options:         -Wall
-  build-depends:       base              >=4.2 && <4.11,
+  build-depends:       base              >=4.2 && <4.12,
                        containers,
                        transformers      >=0.3 && <0.6
   if impl(ghc >=7.2 && <7.5)
@@ -56,9 +57,9 @@ test-suite test
   default-language:    Haskell98
   hs-source-dirs:      tests
   ghc-options:         -Wall
-  build-depends:       base              >=4.5  && <4.11,
-                       tasty             >=0.10 && <0.12,
-                       tasty-quickcheck  >=0.8  && <0.10,
+  build-depends:       base,
+                       tasty             >=0.10 && <1.1,
+                       tasty-quickcheck  >=0.8  && <0.11,
                        spdx
 
 benchmark bench
@@ -68,7 +69,7 @@ benchmark bench
   default-language:    Haskell98
   hs-source-dirs:      tests bench
   ghc-options:         -Wall
-  build-depends:       base              >=4.5  && <4.11,
-                       QuickCheck,
-                       tasty-quickcheck,
+  build-depends:       base,
+                       QuickCheck       >=2.11.3 && <2.12,
+                       tasty-quickcheck >=0.8    && <0.11,
                        spdx
diff --git a/src/Data/SPDX/LatticeSyntax.hs b/src/Data/SPDX/LatticeSyntax.hs
@@ -24,12 +24,14 @@ module Data.SPDX.LatticeSyntax (LatticeSyntax(..), dual, freeVars, equivalent, p
 
 import Control.Applicative
 import Control.Monad
-import Control.Monad.Trans.State
+import Control.Monad.Trans.State.Strict
 import Data.Data
 import Data.Foldable
 import Data.Traversable
 import Prelude hiding (all, or)
 
+import qualified Data.Map.Strict as Map
+
 data LatticeSyntax a = LVar a
                      | LBound Bool
                      | LJoin (LatticeSyntax a) (LatticeSyntax a)
@@ -66,7 +68,7 @@ dual (LMeet a b) = LJoin (dual a) (dual b)
 --
 -- >>> equivalent (LMeet (LVar 'a') (LVar 'b')) (LMeet (LVar 'b') (LVar 'b'))
 -- False
-equivalent :: Eq a => LatticeSyntax a -> LatticeSyntax a -> Bool
+equivalent :: Ord a => LatticeSyntax a -> LatticeSyntax a -> Bool
 equivalent a b = all (uncurry (==)) . runEval $ p
   where p = (,) <$> evalLattice a <*> evalLattice b
 
@@ -79,14 +81,14 @@ equivalent a b = all (uncurry (==)) . runEval $ p
 --
 -- >>> preorder (LVar 'a') (LVar 'a' `LMeet` LVar 'b')
 -- False
-preorder :: Eq a => LatticeSyntax a -> LatticeSyntax a -> Bool
+preorder :: Ord a => LatticeSyntax a -> LatticeSyntax a -> Bool
 preorder a b = (a `LJoin` b) `equivalent` b
 
 -- | Return `True` if for some variable assigment expression evaluates to `True`.
-satisfiable :: Eq a => LatticeSyntax a -> Bool
+satisfiable :: Ord a => LatticeSyntax a -> Bool
 satisfiable = or . runEval . evalLattice
 
-newtype Eval v a = Eval { unEval :: StateT [(v, Bool)] [] a }
+newtype Eval v a = Eval { unEval :: StateT (Map.Map v Bool) [] a }
 
 instance Functor (Eval v) where
   fmap = liftM
@@ -108,19 +110,19 @@ instance MonadPlus (Eval v) where
   Eval a `mplus` Eval b = Eval $ a `mplus` b
 
 runEval :: Eval v a -> [a]
-runEval act = evalStateT (unEval act) []
+runEval act = evalStateT (unEval act) Map.empty
 
-evalLattice :: Eq v => LatticeSyntax v -> Eval v Bool
+evalLattice :: Ord v => LatticeSyntax v -> Eval v Bool
 evalLattice (LVar v)    = guess v
 evalLattice (LBound b)  = return b
 evalLattice (LJoin a b) = evalLattice a ||^ evalLattice b
 evalLattice (LMeet a b) = evalLattice a &&^ evalLattice b
 
-guess :: Eq v => v -> Eval v Bool
+guess :: Ord v => v -> Eval v Bool
 guess v = Eval $ do
   st <- get
-  let remember b = put ((v, b) : st) >> return b
-  case lookup v st of
+  let remember b = put (Map.insert v b st) >> return b
+  case Map.lookup v st of
     Just b  -> return b
     Nothing -> remember True <|> remember False