|
| 1 | +{-# LANGUAGE BlockArguments #-} |
| 2 | +{-# LANGUAGE DataKinds #-} |
| 3 | +{-# LANGUAGE NoImplicitPrelude #-} |
| 4 | +{-# LANGUAGE Strict #-} |
| 5 | +{-# LANGUAGE TemplateHaskell #-} |
| 6 | +{-# LANGUAGE TypeApplications #-} |
| 7 | +{-# OPTIONS_GHC -ddump-simpl-iterations -dsuppress-all #-} |
| 8 | +{-# OPTIONS_GHC -fno-float-in #-} |
| 9 | +{-# OPTIONS_GHC -fno-full-laziness #-} |
| 10 | +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} |
| 11 | +{-# OPTIONS_GHC -fno-local-float-out #-} |
| 12 | +{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} |
| 13 | +{-# OPTIONS_GHC -fno-spec-constr #-} |
| 14 | +{-# OPTIONS_GHC -fno-specialise #-} |
| 15 | +{-# OPTIONS_GHC -fno-strictness #-} |
| 16 | +{-# OPTIONS_GHC -fno-unbox-small-strict-fields #-} |
| 17 | +{-# OPTIONS_GHC -fno-unbox-strict-fields #-} |
| 18 | +{-# OPTIONS_GHC -fplugin PlutusTx.Plugin #-} |
| 19 | + |
| 20 | +module BuiltinUnit.Spec where |
| 21 | + |
| 22 | +import PlutusTx.Prelude |
| 23 | +import Prelude (IO, seq) |
| 24 | + |
| 25 | +import Control.Lens (view) |
| 26 | +import PlutusTx (CompiledCode, compile, getPlcNoAnn) |
| 27 | +import PlutusTx.Builtins.Internal (unitval) |
| 28 | +import Test.Tasty (TestTree, testGroup) |
| 29 | +import Test.Tasty.HUnit (Assertion, testCase) |
| 30 | +import UntypedPlutusCore (progTerm) |
| 31 | + |
| 32 | +tests :: TestTree |
| 33 | +tests = |
| 34 | + testGroup |
| 35 | + "BuiltinUnit" |
| 36 | + [ testCase "error ()" do assertCompiledTerm code1 |
| 37 | + , testCase "unitval" do assertCompiledTerm code2 |
| 38 | + , testCase "locally defined constructor" do assertCompiledTerm code3 |
| 39 | + , testCase "toOpaque ()" do assertCompiledTerm code4 |
| 40 | + ] |
| 41 | + |
| 42 | +{- GHC Core after simplification: |
| 43 | +
|
| 44 | +code1 = case error () of |
| 45 | + validator1_X0 { BuiltinUnit ipv_smFH -> plc Proxy validator1_X0 } |
| 46 | +
|
| 47 | +code2 = case unitval of |
| 48 | + validator2_X0 { BuiltinUnit ipv_smFJ -> plc Proxy validator2_X0 } |
| 49 | +
|
| 50 | +code3 = case unitval of |
| 51 | + builtinUnit_X0 { BuiltinUnit ipv_smFL -> plc Proxy builtinUnit_X0 } |
| 52 | +
|
| 53 | +code4 = case toOpaque $fHasToOpaque()BuiltinUnit () of |
| 54 | + validator4_X0 { BuiltinUnit ipv_smGp -> plc Proxy validator4_X0 } |
| 55 | +
|
| 56 | +Compilation error: |
| 57 | +
|
| 58 | +<no location info>: error: |
| 59 | + GHC Core to PLC plugin: |
| 60 | + Error: Unsupported feature: |
| 61 | + Cannot construct a value of type: BuiltinUnit |
| 62 | + Note: GHC can generate these unexpectedly, you may need |
| 63 | + '-fno-strictness', '-fno-specialise', '-fno-spec-constr', |
| 64 | + '-fno-unbox-strict-fields', or '-fno-unbox-small-strict-fields'. |
| 65 | +Context: Compiling expr: BuiltinUnit |
| 66 | +Context: Compiling expr: BuiltinUnit ipv |
| 67 | +Context: Compiling definition of: validator1 |
| 68 | +Context: Compiling expr: validator1 |
| 69 | +Context: Compiling expr at: test/BuiltinUnit/Spec.hs:75:11-36 |
| 70 | +Context: Compiling expr: validator1 |
| 71 | +-} |
| 72 | + |
| 73 | +code1 :: CompiledCode BuiltinUnit |
| 74 | +code1 = $$(compile [||validator1||]) |
| 75 | + where |
| 76 | + validator1 :: BuiltinUnit |
| 77 | + validator1 = PlutusTx.Prelude.error () |
| 78 | + {-# INLINEABLE validator1 #-} |
| 79 | + |
| 80 | +code2 :: CompiledCode BuiltinUnit |
| 81 | +code2 = $$(compile [||validator2||]) |
| 82 | + where |
| 83 | + validator2 :: BuiltinUnit |
| 84 | + validator2 = unitval |
| 85 | + {-# INLINEABLE validator2 #-} |
| 86 | + |
| 87 | +code3 :: CompiledCode BuiltinUnit |
| 88 | +code3 = $$(compile [||validator3||]) |
| 89 | + where |
| 90 | + validator3 :: BuiltinUnit |
| 91 | + validator3 = builtinUnit |
| 92 | + {-# INLINEABLE validator3 #-} |
| 93 | + |
| 94 | + builtinUnit :: BuiltinUnit |
| 95 | + builtinUnit = unitval |
| 96 | + {-# INLINEABLE builtinUnit #-} |
| 97 | + |
| 98 | +code4 :: CompiledCode BuiltinUnit |
| 99 | +code4 = $$(compile [||validator4||]) |
| 100 | + where |
| 101 | + validator4 :: BuiltinUnit |
| 102 | + validator4 = toOpaque () |
| 103 | + {-# INLINEABLE validator4 #-} |
| 104 | + |
| 105 | +assertCompiledTerm :: CompiledCode a -> Assertion |
| 106 | +assertCompiledTerm code = view progTerm (getPlcNoAnn code) `seq` return @IO () |
0 commit comments