Skip to content

Instantly share code, notes, and snippets.

@srid
Created November 26, 2021 21:18
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save srid/5c387f0b70ea8a132c732b9c5a7c0c94 to your computer and use it in GitHub Desktop.
Save srid/5c387f0b70ea8a132c732b9c5a7c0c94 to your computer and use it in GitHub Desktop.
(program
(let
(nonrec)
(datatypebind
(datatype (tyvardecl Unit (type)) Unit_match (vardecl Unit Unit))
)
(datatypebind
(datatype
(tyvardecl Bool (type))
Bool_match
(vardecl True Bool) (vardecl False Bool)
)
)
(termbind
(strict)
(vardecl equalsData (fun (con data) (fun (con data) Bool)))
(lam
d
(con data)
(lam
d
(con data)
[
[
[ { (builtin ifThenElse) Bool } [ [ (builtin equalsData) d ] d ] ]
True
]
False
]
)
)
)
(termbind
(strict)
(vardecl trace (all a (type) (fun (con string) (fun a a))))
(abs a (type) (lam t (con string) (lam a a a)))
)
(lam
d
(con data)
(lam
r
(con data)
(lam
ds
(con data)
{
[
[
{
[
Bool_match
{
[
[
{
[
Bool_match
{
[
[
{
[ Bool_match [ [ equalsData d ] r ] ]
(all dead (type) Bool)
}
(abs dead (type) True)
]
(abs
dead
(type)
[
[ { trace Bool } (con string "oops1") ]
False
]
)
]
(all dead (type) dead)
}
]
(all dead (type) Bool)
}
(abs
dead
(type)
{
[
[
{
[ Bool_match [ [ equalsData r ] d ] ]
(all dead (type) Bool)
}
(abs dead (type) True)
]
(abs
dead
(type)
[
[ { trace Bool } (con string "oops2") ]
False
]
)
]
(all dead (type) dead)
}
)
]
(abs dead (type) False)
]
(all dead (type) dead)
}
]
(all dead (type) Unit)
}
(abs dead (type) Unit)
]
(abs dead (type) (error Unit))
]
(all dead (type) dead)
}
)
)
)
)
)
(program
(let
(nonrec)
(datatypebind
(datatype (tyvardecl Unit (type)) Unit_match (vardecl Unit Unit))
)
(datatypebind
(datatype
(tyvardecl Bool (type))
Bool_match
(vardecl True Bool) (vardecl False Bool)
)
)
(termbind
(strict)
(vardecl equalsData (fun (con data) (fun (con data) Bool)))
(lam
d
(con data)
(lam
d
(con data)
[
[
[ { (builtin ifThenElse) Bool } [ [ (builtin equalsData) d ] d ] ]
True
]
False
]
)
)
)
(lam
d
(con data)
(lam
r
(con data)
(lam
ds
(con data)
{
[
[
{
[
Bool_match
{
[
[
{
[
Bool_match
{
[
[
{
[ Bool_match [ [ equalsData d ] r ] ]
(all dead (type) Bool)
}
(abs dead (type) True)
]
(abs
dead
(type)
[
[
{ (builtin trace) Bool }
(con string "oops1")
]
False
]
)
]
(all dead (type) dead)
}
]
(all dead (type) Bool)
}
(abs
dead
(type)
{
[
[
{
[ Bool_match [ [ equalsData r ] d ] ]
(all dead (type) Bool)
}
(abs dead (type) True)
]
(abs
dead
(type)
[
[
{ (builtin trace) Bool }
(con string "oops2")
]
False
]
)
]
(all dead (type) dead)
}
)
]
(abs dead (type) False)
]
(all dead (type) dead)
}
]
(all dead (type) Unit)
}
(abs dead (type) Unit)
]
(abs dead (type) (error Unit))
]
(all dead (type) dead)
}
)
)
)
)
)
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:dump-uplc #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:remove-trace #-}
-- | An "empty" script validator that always succeeds.
--
-- Represents the smallest validator script possible in Plutus.
module Piecemeal.Empty (validator, validatorPir) where
import Ledger
( Address,
Validator,
ValidatorHash,
mkValidatorScript,
scriptAddress,
)
import qualified Ledger.Scripts as Scripts
import qualified PlutusTx
import qualified PlutusTx.Code as PC
import PlutusTx.Prelude
import qualified Prettyprinter as PP
validatorPir :: PP.Doc ann
validatorPir =
PP.pretty $
PC.getPir
$$(PlutusTx.compile [||mkValidator||])
{-# INLINEABLE mkValidator #-}
mkValidator :: BuiltinData -> BuiltinData -> BuiltinData -> ()
mkValidator d r _ =
if traceIfFalse "oops1" (d == r) && traceIfFalse "oops2" (r == d)
then ()
else error ()
validator :: Validator
validator = mkValidatorScript $$(PlutusTx.compile [||mkValidator||])
valHash :: Ledger.ValidatorHash
valHash = Scripts.validatorHash validator
scrAddress :: Ledger.Address
scrAddress = scriptAddress validator
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment