-
Notifications
You must be signed in to change notification settings - Fork 9
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
21 changed files
with
852 additions
and
230 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,108 @@ | ||
| (env-data {'k:1}) | ||
|
|
||
| (defun check-hash-equivalent (mstring:string h:string) | ||
| (expect (concat ["Hash of module ", mstring, " matches"]) (at "hash" (describe-module mstring)) h) | ||
| ) | ||
|
|
||
| (module m m-gov | ||
| (defcap m-gov () true) | ||
|
|
||
| (defconst fconst:integer (read-integer "k")) | ||
|
|
||
| (defun mdfn () 1) | ||
|
|
||
| (defpact mdpact () | ||
| (step 1)) | ||
|
|
||
| (defschema sc a:integer) | ||
|
|
||
| (deftable mdtbl:{sc}) | ||
| ) | ||
|
|
||
| ; base case | ||
| (check-hash-equivalent "m" "QCLU54Co9PbQqiqFz1F3M-pPgdn59ANGIG7bwNVFAJk") | ||
|
|
||
| (env-data {'k:2}) | ||
| (module m m-gov | ||
| (defcap m-gov () true) | ||
|
|
||
| (defconst fconst:integer (read-integer "k")) | ||
|
|
||
| (defun mdfn () 1) | ||
|
|
||
| (defpact mdpact () | ||
| (step 1)) | ||
|
|
||
| (defschema sc a:integer) | ||
|
|
||
| (deftable mdtbl:{sc}) | ||
| ) | ||
|
|
||
|
|
||
| ; Defconst changed, ensure hash changed | ||
| (check-hash-equivalent "m" "83c6a-9Hmv9yHOkaY1Y2LmHoHvXLWYc_lQ-Oacg8URw") | ||
|
|
||
| (module m m-gov | ||
| (defcap m-gov () true) | ||
|
|
||
| (defconst fconst:integer (read-integer "k")) | ||
|
|
||
| (defun mdfn () 2) | ||
|
|
||
| (defpact mdpact () | ||
| (step 1)) | ||
|
|
||
| (defschema sc a:integer) | ||
|
|
||
| (deftable mdtbl:{sc}) | ||
| ) | ||
|
|
||
|
|
||
| ; Basic code changed: hash should change | ||
| (check-hash-equivalent "m" "WhYWXrM3oUwXRaiPela_j7d2nF5snW5SPjGUOuuJu7c") | ||
|
|
||
| ; Modules, interfaces and deps | ||
| (module n gg | ||
| (use m) | ||
| (defcap gg () true) | ||
|
|
||
| (defconst nfconst:integer (read-integer "k")) | ||
|
|
||
| (defun nf () (mdfn)) | ||
|
|
||
| ) | ||
|
|
||
| (check-hash-equivalent "n" "v30ra86hQ35kT1k8pdXnGsGU434VD7Ysa7smYhHFPs0") | ||
|
|
||
| ; Update dependent module, ensure hash changes | ||
| (module m m-gov | ||
| (defcap m-gov () true) | ||
|
|
||
| (defconst fconst:integer (read-integer "k")) | ||
|
|
||
| (defun mdfn () 3) | ||
|
|
||
| (defpact mdpact () | ||
| (step 1)) | ||
|
|
||
| (defschema sc a:integer) | ||
|
|
||
| (deftable mdtbl:{sc}) | ||
| ) | ||
|
|
||
| ; n has not changed, but m has, it should change the dep | ||
| (module n gg | ||
| (use m) | ||
| (defcap gg () true) | ||
|
|
||
| (defconst nfconst:integer (read-integer "k")) | ||
|
|
||
| (defun nf () (mdfn)) | ||
|
|
||
| ) | ||
|
|
||
| ; m changed, hash should have changed | ||
| (check-hash-equivalent "m" "BVrxWuHbjy9heR9AhAZnbusKvSKiyzrEYt8_0LCBRqs") | ||
|
|
||
| ; n did not change, but the dependency hash changed, so it should also change the hash | ||
| (check-hash-equivalent "n" "ETUjfmMviiXCyZYxJLzk1uXBQFizGizyqPGz1XIt1lA") |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,72 @@ | ||
| module Pact.Core.IR.ConstEval | ||
| ( evalModuleDefConsts | ||
| , evalIfaceDefConsts | ||
| , evalTLConsts ) where | ||
|
|
||
| import Control.Lens | ||
| import qualified Data.Map.Strict as M | ||
|
|
||
| import Pact.Core.Names | ||
| import Pact.Core.Type | ||
| import Pact.Core.Environment | ||
| import Pact.Core.Persistence | ||
| import Pact.Core.Interpreter | ||
| import Pact.Core.IR.Term | ||
| import Pact.Core.Errors | ||
|
|
||
| evalTLConsts :: (MonadEval b i m) => Interpreter b i m -> TopLevel Name Type b i -> m (TopLevel Name Type b i) | ||
| evalTLConsts interp = \case | ||
| TLTerm t -> pure $ TLTerm t | ||
| TLInterface ti -> TLInterface <$> evalIfaceDefConsts interp ti | ||
| TLModule m -> TLModule <$> evalModuleDefConsts interp m | ||
| TLUse u i -> pure $ TLUse u i | ||
|
|
||
| -- Todo: this may need a different IR for module, or at least a newtype wrapper over `Name` | ||
| evalModuleDefConsts | ||
| :: (MonadEval b i m) | ||
| => Interpreter b i m | ||
| -> Module Name Type b i | ||
| -> m (Module Name Type b i) | ||
| evalModuleDefConsts interp (Module mname mgov defs blessed imports implements mhash info) = do | ||
| lo <- useEvalState esLoaded | ||
| defs' <- traverse go defs | ||
| esLoaded .== lo | ||
| pure (Module mname mgov defs' blessed imports implements mhash info) | ||
| where | ||
| go defn = do | ||
| d' <- case defn of | ||
| DConst dc -> case _dcTerm dc of | ||
| TermConst term -> _interpret interp PSysOnly term >>= \case | ||
| IPV pv _ -> pure (DConst (set dcTerm (EvaledConst pv) dc)) | ||
| _ -> throwExecutionError info (ConstIsNotAPactValue (QualifiedName (_dcName dc) mname)) | ||
| EvaledConst _ -> pure defn | ||
| _ -> pure defn | ||
| let dn = defName defn | ||
| let fqn = FullyQualifiedName mname dn mhash | ||
| loAllLoaded %== M.insert fqn d' | ||
| pure d' | ||
|
|
||
|
|
||
| -- Todo: this may need a different IR for module, or at least a newtype wrapper over `Name` | ||
| evalIfaceDefConsts | ||
| :: (MonadEval b i m) | ||
| => Interpreter b i m | ||
| -> Interface Name Type b i | ||
| -> m (Interface Name Type b i) | ||
| evalIfaceDefConsts interp (Interface ifname ifdefns imps ifh info) = do | ||
| lo <- useEvalState esLoaded | ||
| ifdefns' <- traverse go ifdefns | ||
| esLoaded .== lo | ||
| pure (Interface ifname ifdefns' imps ifh info) | ||
| where | ||
| go defn = case defn of | ||
| IfDConst dc -> case _dcTerm dc of | ||
| TermConst term -> _interpret interp PSysOnly term >>= \case | ||
| IPV pv _ -> do | ||
| let dn = _dcName dc | ||
| fqn = FullyQualifiedName ifname dn ifh | ||
| loAllLoaded %== M.insert fqn (DConst dc) | ||
| pure (IfDConst (set dcTerm (EvaledConst pv) dc)) | ||
| _ -> throwExecutionError info (ConstIsNotAPactValue (QualifiedName (_dcName dc) ifname)) | ||
| EvaledConst _ -> pure defn | ||
| _ -> pure defn |
Oops, something went wrong.