https://github.com/danr/stm-promise

Simple STM promise-like thingys
https://github.com/danr/stm-promise

Last synced: over 1 year ago
JSON representation

Simple STM promise-like thingys

• Host: GitHub
• URL: https://github.com/danr/stm-promise
• Owner: danr
• License: lgpl-3.0
• Created: 2013-01-25T21:33:19.000Z (over 13 years ago)
• Default Branch: master
• Last Pushed: 2018-03-12T08:08:04.000Z (over 8 years ago)
• Last Synced: 2024-03-15T12:26:17.010Z (over 2 years ago)
• Language: Haskell
• Size: 1.97 MB
• Stars: 1
• Watchers: 4
• Forks: 1
• Open Issues: 1
• Metadata Files:
  • Readme: README.md
  • License: LICENSE

Awesome Lists containing this project

README

          
### STM Promises

[![Build Status](https://travis-ci.org/danr/stm-promise.png?branch=master)](https://travis-ci.org/danr/stm-promise)

# An example

Running the theorem prover eprover in parallel:

    import Prelude hiding (mapM)

    import Data.Traversable

    import Data.List

    import Data.Maybe

    import Control.Concurrent.STM.Promise

    import Control.Concurrent.STM.Promise.Process

    import Control.Concurrent.STM.Promise.Tree

    import Control.Concurrent.STM.Promise.Workers

    {- | A tree for this file structure:

       ├── mul-commutative

       │   ├── induction_x_0.tptp

       │   ├── induction_x_1.tptp

       │   ├── induction_x_y_0.tptp

       │   ├── induction_x_y_1.tptp

       │   ├── induction_x_y_2.tptp

       │   ├── induction_x_y_3.tptp

       │   ├── induction_y_0.tptp

       │   ├── induction_y_1.tptp

       │   └── no_induction_0.tptp

       └── plus-commutative

           ├── induction_x_0.tptp

           ├── induction_x_1.tptp

           ├── induction_x_y_0.tptp

           ├── induction_x_y_1.tptp

           ├── induction_x_y_2.tptp

           ├── induction_x_y_3.tptp

           ├── induction_y_0.tptp

           ├── induction_y_1.tptp

           └── no_induction_0.tptp

    -}

    file_tree :: Tree FilePath

    file_tree = fmap (++ ".tptp") $ tryAll

       [ fmap ("mul-commutative/" ++) $ requireAny

         [ fmap ("induction_x_" ++) $ requireAll $ map Leaf ["0","1"]

         , fmap ("induction_y_" ++) $ requireAll $ map Leaf ["0","1"]

         , fmap ("induction_x_y_" ++) $ requireAll $ map Leaf ["0","1","2","3"]

         , Leaf "no_induction_0"

         ]

       , fmap ("plus-commutative/" ++) $ requireAny

         [ fmap ("induction_x_" ++) $ requireAll $ map Leaf ["0","1"]

         , fmap ("induction_y_" ++) $ requireAll $ map Leaf ["0","1"]

         , fmap ("induction_x_y_" ++) $ requireAll $ map Leaf ["0","1","2","3"]

         , Leaf "no_induction_0"

         ]

       ]

    success :: ProcessResult -> Bool

    success r = excode r == ExitSuccess && any (`isInfixOf` stdout r) ok

      where

        ok = ["Theorem","Unsatisfiable"]

    eproverPromise :: FilePath -> IO (Promise [(FilePath,Bool)])

    eproverPromise file = do

        let args = ["-xAuto","-tAuto",'-':"-tptp3-format","-s"]

        promise <- processPromise "eprover" (file : args) ""

        let chres :: ProcessResult -> [(FilePath,Bool)]

            chres r = [ (file,success r) ]

        return $ fmap chres promise

    main :: IO ()

    main = do

        promise_tree <- mapM eproverPromise file_tree

        let timeout      = 1000 * 1000 -- microseconds

            processes    = 2

        workers (Just timeout) processes (interleave promise_tree)

        res <- evalTree (any (not . snd)) promise_tree

        putStrLn "Results: "

        mapM_ print res

The result of this run is:

    Results:

    ("plus-commutative/induction_x_y_0.tptp",True)

    ("plus-commutative/induction_x_y_1.tptp",True)

    ("plus-commutative/induction_x_y_2.tptp",True)

    ("plus-commutative/induction_x_y_3.tptp",True)

This means that four out of four obligations for commutativity of plus

succeeded when doing induction on both x and y.