Skip to content

Commit

Permalink
Merge branch 'master' into imp/setup-docs
Browse files Browse the repository at this point in the history
  • Loading branch information
mchakravarty committed Aug 17, 2018
2 parents ef7b6c2 + bd79e94 commit 9b65265
Show file tree
Hide file tree
Showing 38 changed files with 826 additions and 482 deletions.
1 change: 1 addition & 0 deletions .gitattributes
@@ -0,0 +1 @@
pkgs/default.nix linguist-generated=true
8 changes: 8 additions & 0 deletions README.md
Expand Up @@ -27,3 +27,11 @@ environment defined in `shell.nix`, and run `pkgs/generate.sh`.
## CI

The CI will build the projects, and also the tests in `default.nix`.

If you add a dependency to a `.cabal` file, you will need to run
`./pkgs/generate.sh` and commit the changes.

## Docs

Docs are built by hydra. The latest docs for plutus core master branch can be found at
https://hydra.iohk.io/job/serokell/plutus/language-plutus-core.x86_64-linux/latest/download/2
13 changes: 11 additions & 2 deletions default.nix
Expand Up @@ -18,14 +18,23 @@ with pkgs.lib;
with pkgs.haskell.lib;

let
doHaddockHydra = drv: overrideCabal drv (attrs: {
doHaddock = true;
postInstall = ''
${attrs.postInstall or ""}
mkdir -pv $doc/nix-support
tar -czvf $doc/${attrs.pname}-docs.tar.gz -C $doc/share/doc/html .
echo "file binary-dist $doc/${attrs.pname}-docs.tar.gz" >> $doc/nix-support/hydra-build-products
echo "report ${attrs.pname}-docs.html $doc/share/doc/html index.html" >> $doc/nix-support/hydra-build-products
'';
});
addRealTimeTestLogs = drv: overrideCabal drv (attrs: {
testTarget = "--show-details=streaming";
});
plutusPkgs = (import ./pkgs { inherit pkgs; }).override {
overrides = self: super: {
plutus-prototype = addRealTimeTestLogs super.plutus-prototype;
language-plutus-core = addRealTimeTestLogs super.language-plutus-core;

language-plutus-core = doHaddockHydra (addRealTimeTestLogs super.language-plutus-core);
};
};
cleanSourceFilter = with pkgs.stdenv;
Expand Down
8 changes: 4 additions & 4 deletions language-plutus-core/.hlint.yaml
@@ -1,8 +1,8 @@
---
- functions:
- {name: unsafePerformIO, within: []}
- {name: error, within: [Main]}
- {name: undefined, within: []}
- {name: unsafePerformIO, within: [PlutusPrelude]}
- {name: error, within: [Main, Evaluation.Constant.Success, Evaluation.Generator, Language.PlutusCore.Constant.Apply]}
- {name: undefined, within: [Language.PlutusCore.Constant.Apply]}
- {name: fromJust, within: []}
- {name: foldl, within: []}

Expand All @@ -19,7 +19,7 @@
- error: {lhs: "maybe mempty", rhs: "foldMap", name: "Use foldMap"}
- error: {lhs: "mconcat", rhs: "fold", name: "Generalize mconcat"}

- ignore: {name: Reduce duplication, within: [Language.PlutusCore.Renamer]}
- ignore: {name: Reduce duplication, within: [Language.PlutusCore.Renamer, Language.PlutusCore.Constant.Prelude]}

- fixity: infixr 8 .*
- fixity: infixr 3 ***
Expand Down
4 changes: 1 addition & 3 deletions language-plutus-core/Justfile
@@ -1,9 +1,7 @@
ci:
cabal new-build all
cabal new-test
hlint src bench test
stack build --bench --test --no-run-benchmarks --no-run-tests
weeder .
hlint src bench test prelude recursion
cabal check

docs:
Expand Down
16 changes: 16 additions & 0 deletions language-plutus-core/README.md
Expand Up @@ -58,3 +58,19 @@ NB: Whenever the global uniqueness property is not a given, care needs be taken
The type checker synthesises the kind of a given type and the type of a given term. This does not involve any form of inference as Plutus Core is already fully typed. It merely checks the consistency of all variable declarations and the well-formedness of types and terms, while deriving the kind or type of the given type or term.

NB: The type checker requires terms to meet the global unqiueness property. If this is not a given, use a renamer pass to suitably pre-process the term in question.

### Evaluation

The CK machine can be used to evaluate programs. For this, feed a type checked program to the `runCk` function defined in the `Language.PlutusCore.CkMachine` module:

```haskell
runCk :: Program TyName Name () -> CkEvalResult
```

It returns a `CkEvalResult` which is either a succesfully computed `Value` (which is a type synonym for `Term`) or a failure:

```haskell
data CkEvalResult
= CkEvalSuccess (Value TyName Name ())
| CkEvalFailure
```
6 changes: 0 additions & 6 deletions language-plutus-core/TODO.md

This file was deleted.

2 changes: 1 addition & 1 deletion language-plutus-core/bench/Bench.hs
Expand Up @@ -9,7 +9,7 @@ main :: IO ()
main =
defaultMain [ env envFile $ \ f ->
bgroup "format"
[ bench "format" $ nf format f ]
[ bench "format" $ nf (format defaultCfg) f ]
, env files $ \ ~(f, g) ->
bgroup "parse"
[ bench "parse (addInteger)" $ nf parse f
Expand Down
1 change: 1 addition & 0 deletions language-plutus-core/cabal.project
@@ -1,6 +1,7 @@
packages: ./
optimization: 2
constraints: language-plutus-core +development
, recursion-schemes -template-haskell
tests: true
benchmarks: true
documentation: true
Expand Down
6 changes: 1 addition & 5 deletions language-plutus-core/cabal.project.new
Expand Up @@ -12,8 +12,4 @@ allow-newer:
base
template-haskell
stm

source-repository-package
type: git
location: https://github.com/haskell/stm
tag: 4c24db6071fc1319232934562f7dbed45d498831
Cabal
40 changes: 21 additions & 19 deletions language-plutus-core/language-plutus-core.cabal
@@ -1,4 +1,4 @@
cabal-version: 1.18
cabal-version: 2.0
name: language-plutus-core
version: 0.1.0.0
license: BSD3
Expand Down Expand Up @@ -30,8 +30,9 @@ library
exposed-modules:
Language.PlutusCore
Language.PlutusCore.Constant
PlutusPrelude
build-tools: alex -any, happy >=1.17.1
hs-source-dirs: src
hs-source-dirs: src prelude recursion
other-modules:
Language.PlutusCore.Type
Language.PlutusCore.Name
Expand All @@ -47,16 +48,17 @@ library
Language.PlutusCore.Renamer
Language.PlutusCore.Error
Language.PlutusCore.TypeSynthesis
PlutusPrelude
Language.PlutusCore.Normalize
Data.Functor.Foldable.Monadic
default-language: Haskell2010
other-extensions: DeriveGeneric DeriveAnyClass StandaloneDeriving
GeneralizedNewtypeDeriving TemplateHaskell KindSignatures
TypeFamilies DeriveFunctor DeriveFoldable DeriveTraversable
FlexibleContexts OverloadedStrings DerivingStrategies
MonadComprehensions
GeneralizedNewtypeDeriving TypeFamilies DeriveFunctor
DeriveFoldable DeriveTraversable FlexibleContexts OverloadedStrings
DerivingStrategies MonadComprehensions FlexibleInstances
ConstrainedClassMethods TupleSections GADTs RankNTypes
ghc-options: -Wall -Wnoncanonical-monad-instances
-Wincomplete-uni-patterns -Wincomplete-record-updates
-Wredundant-constraints
-Wredundant-constraints -Widentities
build-depends:
base >=4.9 && <5,
bytestring -any,
Expand All @@ -66,15 +68,15 @@ library
transformers -any,
deepseq -any,
recursion-schemes >=5.0.1,
prettyprinter -any,
text -any,
value-supply -any,
prettyprinter -any,
microlens -any,
value-supply -any,
composition-prelude -any

if (flag(development) && impl(ghc <8.4))
ghc-options: -Werror

if impl(ghc >=8.4)
ghc-options: -Wmissing-export-lists

Expand All @@ -83,6 +85,7 @@ test-suite language-plutus-core-test
main-is: Spec.hs
hs-source-dirs: test
other-modules:
Generators
Evaluation.Constant.GenTypedBuiltinSized
Evaluation.Constant.Apply
Evaluation.Constant.Success
Expand All @@ -93,7 +96,7 @@ test-suite language-plutus-core-test
other-extensions: OverloadedStrings
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
-Wincomplete-uni-patterns -Wincomplete-record-updates
-Wredundant-constraints -Wnoncanonical-monad-instances
-Wredundant-constraints -Widentities
build-depends:
base -any,
language-plutus-core -any,
Expand All @@ -108,10 +111,10 @@ test-suite language-plutus-core-test
containers -any,
mtl -any,
mmorph -any

if (flag(development) && impl(ghc <8.4))
ghc-options: -Werror

if impl(ghc >=8.4)
ghc-options: -Wmissing-export-lists

Expand All @@ -121,16 +124,15 @@ benchmark language-plutus-core-bench
hs-source-dirs: bench
default-language: Haskell2010
ghc-options: -Wall -Wincomplete-uni-patterns
-Wincomplete-record-updates -Wredundant-constraints
-Wnoncanonical-monad-instances
-Wincomplete-record-updates -Wredundant-constraints -Widentities
build-depends:
base -any,
language-plutus-core -any,
criterion -any,
bytestring -any

if flag(development)
ghc-options: -Werror

if impl(ghc >=8.4)
ghc-options: -Wmissing-export-lists
125 changes: 125 additions & 0 deletions language-plutus-core/prelude/PlutusPrelude.hs
@@ -0,0 +1,125 @@
{-# LANGUAGE DeriveFunctor #-}

module PlutusPrelude ( -- * Reëxports from base
(&&&)
, toList
, bool
, first
, second
, on
, isJust
, guard
, foldl'
, fold
, throw
, join
, Generic
, NFData
, Natural
, NonEmpty (..)
, Pretty (..)
, Word8
, Semigroup (..)
, Alternative (..)
, Exception
, PairT (..)
, Typeable
-- * Reëxports from "Control.Composition"
, (.*)
-- * Custom functions
, prettyString
, freshInt
, dropFresh
, prettyText
, debugText
, render
, repeatM
, (?)
, Debug (..)
, Fresh
-- Reëxports from "Data.Text.Prettyprint.Doc"
, (<+>)
, parens
, squotes
, Doc
) where

import Control.Applicative (Alternative (..))
import Control.Arrow ((&&&))
import Control.Composition ((.*))
import Control.DeepSeq (NFData)
import Control.Exception (Exception, throw)
import Control.Monad (guard, join)
import Control.Monad.Trans.Reader
import Data.Bifunctor (first, second)
import Data.Bool (bool)
import Data.Foldable (fold, toList)
import Data.Function (on)
import Data.List (foldl')
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (isJust)
import Data.Semigroup
import Data.Supply
import qualified Data.Text as T
import Data.Text.Prettyprint.Doc
import Data.Text.Prettyprint.Doc.Render.String (renderString)
import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)
import Data.Typeable (Typeable)
import Data.Word (Word8)
import GHC.Generics (Generic)
import GHC.Natural (Natural)
import System.IO.Unsafe

infixr 2 ?

-- | This is like 'Pretty', but it dumps 'Unique's for each 'Name' / 'TyName' as
-- well.
class Debug a where
debug :: a -> Doc ann

-- | Render a 'Program' as strict 'Text'.
prettyText :: Pretty a => a -> T.Text
prettyText = render . pretty

debugText :: Debug a => a -> T.Text
debugText = render . debug

render :: Doc a -> T.Text
render = renderStrict . layoutSmart defaultLayoutOptions

-- | Make sure your 'Applicative' is sufficiently lazy!
repeatM :: Applicative f => f a -> f [a]
repeatM x = (:) <$> x <*> repeatM x

newtype PairT b f a = PairT
{ unPairT :: f (b, a)
}

instance Functor f => Functor (PairT b f) where
fmap f (PairT p) = PairT $ fmap (fmap f) p

newtype Fresh a = Fresh
{ unFresh :: Reader (Supply Int) a
} deriving (Functor)

instance Applicative Fresh where
pure = Fresh . pure
Fresh g <*> Fresh f = Fresh . reader $ \s ->
let (s1, s2) = split2 s in runReader g s1 (runReader f s2)

instance Monad Fresh where
Fresh g >>= h = Fresh . reader $ \s ->
let (s1, s2) = split2 s in runReader (unFresh . h $ runReader g s1) s2

freshInt :: Fresh Int
freshInt = Fresh $ reader supplyValue

dropFresh :: Fresh a -> a
dropFresh (Fresh f) = runReader f $ unsafePerformIO newEnumSupply
{-# NOINLINE dropFresh #-}

(?) :: Alternative f => Bool -> a -> f a
(?) b x = x <$ guard b

prettyString :: Pretty a => a -> String
prettyString = renderString . layoutPretty defaultLayoutOptions . pretty
11 changes: 11 additions & 0 deletions language-plutus-core/recursion/Data/Functor/Foldable/Monadic.hs
@@ -0,0 +1,11 @@
{-# LANGUAGE FlexibleContexts #-}

module Data.Functor.Foldable.Monadic ( cataM
) where

import Control.Monad ((<=<))
import Data.Functor.Foldable

-- | A monadic catamorphism
cataM :: (Recursive t, Traversable (Base t), Monad m) => (Base t a -> m a) -> (t -> m a)
cataM phi = c where c = phi <=< (traverse c . project)

0 comments on commit 9b65265

Please sign in to comment.