Skip to content
Permalink
Browse files

started to qualify all imports in the michelson codebase (#321)

* started to qualify all imports in the michelson codebase

* qualiifed more imports
  • Loading branch information
mariari committed Feb 11, 2020
1 parent e43d23d commit 91a41078263ff01fde3a3cfaa9eee9e689935b18
@@ -301,7 +301,6 @@ This module provides a default contract environment
+ [[Compilation/Environment]]
+ [[Lambda]]
+ [[Compilation/Type]]
+ [[Michelson/Compilation/Types]]
+ [[Compilation/Util]]
+ [[VirtualStack]]
+ [[Optimisation]]
@@ -314,7 +313,7 @@ This module provides a default contract environment
+ [[VirtualStack]]
+ [[Library]]
***** Datatypes
Datatypes & pattern matching.
Datatypes and pattern matching.
- _Relies on_
+ [[Michelson/Compilation/Types]]
+ [[Compilation/Util]]
@@ -333,15 +332,13 @@ Datatypes & pattern matching.
+ [[Michelson/Compilation/Types]]
+ [[Compilation/Util]]
+ [[VirtualStack]]
+ [[Michelson/Parameterisation]]
+ [[ErasedAnn]]
+ [[Library]]
***** Prim
- Compilation of primitive terms to Michelson instruction sequences.
- _Relies on_
+ [[Compilation/Environment]]
+ [[Compilation/Type]]
+ [[Michelson/Compilation/Types]]
+ [[VirtualStack]]
+ [[ErasedAnn]]
+ [[Library]]
@@ -352,7 +349,6 @@ Datatypes & pattern matching.
+ [[Compilation/Environment]]
+ [[Prim]]
+ [[Compilation/Type]]
+ [[Michelson/Compilation/Types]]
+ [[Compilation/Util]]
+ [[VirtualStack]]
+ [[Michelson/Parameterisation]]
@@ -5,12 +5,11 @@ module Juvix.Backends.Michelson.Compilation where
import qualified Data.Map as Map
import qualified Data.Text.Lazy as L
import Juvix.Backends.Michelson.Compilation.Environment
import Juvix.Backends.Michelson.Compilation.Lambda
import Juvix.Backends.Michelson.Compilation.Type
import Juvix.Backends.Michelson.Compilation.Types
import Juvix.Backends.Michelson.Compilation.Util
import qualified Juvix.Backends.Michelson.Compilation.Lambda as Lambda
import qualified Juvix.Backends.Michelson.Compilation.Type as Type
import qualified Juvix.Backends.Michelson.Compilation.Util as Util
import qualified Juvix.Backends.Michelson.Compilation.VirtualStack as VStack
import Juvix.Backends.Michelson.Optimisation
import qualified Juvix.Backends.Michelson.Optimisation as Optimisation
import Juvix.Library hiding (Type)
import qualified Michelson.Printer as M
import qualified Michelson.TypeCheck as M
@@ -47,15 +46,15 @@ compileToMichelsonContract ∷
Type
m (M.Contract' M.ExpandedOp, M.SomeContract)
compileToMichelsonContract term ty = do
michelsonTy typeToType ty
michelsonTy Type.typeToType ty
case michelsonTy of
M.Type (M.TLambda argTy@(M.Type (M.TPair _ _ paramTy storageTy) _) _) _ do
michelsonOp' termToMichelson term argTy
let michelsonOp = leftSeq michelsonOp'
michelsonOp' Lambda.termToMichelson term argTy
let michelsonOp = Util.leftSeq michelsonOp'
let contract = M.Contract paramTy storageTy [michelsonOp]
case M.typeCheckContract Map.empty contract of
Right _ do
optimised optimise michelsonOp
optimised Optimisation.optimise michelsonOp
let optimisedContract = M.Contract paramTy storageTy [optimised]
case M.typeCheckContract Map.empty optimisedContract of
Right c pure (optimisedContract, c)
@@ -74,11 +73,11 @@ compileToMichelsonExpr ∷
Type
m (SomeInstr)
compileToMichelsonExpr term ty = do
michelsonTy typeToType ty
michelsonTy Type.typeToType ty
case michelsonTy of
M.Type (M.TLambda argTy@(M.Type (M.TPair _ _ paramTy storageTy) _) _) _ do
michelsonOp' termToMichelson term argTy
let michelsonOp = leftSeq michelsonOp'
M.Type (M.TLambda argTy@(M.Type (M.TPair _ _ _paramTy _storageTy) _) _) _ do
michelsonOp' Lambda.termToMichelson term argTy
let michelsonOp = Util.leftSeq michelsonOp'
MT.withSomeSingT (MT.fromUType argTy) $ \sty
case M.runTypeCheckIsolated (M.typeCheckList [michelsonOp] (sty M.-:& M.SNil)) of
Right (_ M.:/ (s M.::: _)) pure (SomeInstr s)
@@ -2,8 +2,8 @@
-- - Sanity checks for Michelson compilation.
module Juvix.Backends.Michelson.Compilation.Checks where

import Juvix.Backends.Michelson.Compilation.Types
import Juvix.Backends.Michelson.Compilation.Util
import qualified Juvix.Backends.Michelson.Compilation.Types as Types
import qualified Juvix.Backends.Michelson.Compilation.Util as Util
import qualified Juvix.Backends.Michelson.Compilation.VirtualStack as VStack
import Juvix.Library
import qualified Michelson.TypeCheck as M
@@ -12,35 +12,35 @@ import qualified Michelson.Untyped as M
-- Check that the stack types tracked internally & of the instruction match.
stackGuard
( HasState "stack" VStack.T m,
HasThrow "compilationError" CompilationError m,
HasThrow "compilationError" Types.CompilationError m,
Show a
)
a
M.Type
m (Either b Op)
m (Either b Op)
m (Either b Types.Op)
m (Either b Types.Op)
stackGuard term paramTy func = do
start get @"stack"
maybeInstr func
end get @"stack"
case maybeInstr of
Left _ pure maybeInstr
Right instr do
case stackToStack start of
case Util.stackToStack start of
M.SomeHST startStack do
-- TODO: Real originated contracts.
let originatedContracts = mempty
typedChecked = M.typeCheckList [instr] startStack
case M.runTypeCheck paramTy originatedContracts typedChecked of
Left err throw @"compilationError" (DidNotTypecheck err)
Left err throw @"compilationError" (Types.DidNotTypecheck err)
Right (_ M.:/ (M.AnyOutInstr _))
throw @"compilationError" (NotYetImplemented "any out instr")
throw @"compilationError" (Types.NotYetImplemented "any out instr")
Right (_ M.:/ (_ M.::: endType)) do
if stackToStack end == M.SomeHST endType
if Util.stackToStack end == M.SomeHST endType
then pure maybeInstr
else
throw @"compilationError"
( InternalFault
( Types.InternalFault
( mconcat
[ "stack mismatch while compiling ",
show term,
@@ -1,25 +1,26 @@
-- |
-- Datatypes & pattern matching.
-- Datatypes and pattern matching.
module Juvix.Backends.Michelson.Compilation.Datatypes where

import Juvix.Backends.Michelson.Compilation.Types hiding (Type)
import Juvix.Backends.Michelson.Compilation.Util
import qualified Juvix.Backends.Michelson.Compilation.Types as Type
import qualified Juvix.Backends.Michelson.Compilation.Util as Util
import qualified Juvix.Backends.Michelson.Compilation.VirtualStack as VStack
import Juvix.Library hiding (Type)
import Michelson.Untyped

pack
m.
(HasThrow "compilationError" CompilationError m)
(HasThrow "compilationError" Type.CompilationError m)
Type
m ExpandedInstr
pack (Type TUnit _) = pure (PUSH "" (Type TUnit "") ValueUnit)
pack ty = throw @"compilationError" (NotYetImplemented ("pack: " <> show ty))
pack ty =
throw @"compilationError" (Type.NotYetImplemented ("pack: " <> show ty))

unpack
m.
( HasState "stack" VStack.T m,
HasThrow "compilationError" CompilationError m
HasThrow "compilationError" Type.CompilationError m
)
Type
[Maybe Symbol]
@@ -58,29 +59,31 @@ unpack (Type ty _) binds =
)
pure (PrimEx (CDR "" ""))
[Nothing, Nothing]
genReturn (PrimEx DROP)
_ throw @"compilationError" (InternalFault "binds do not match type")
_ throw @"compilationError" (NotYetImplemented ("unpack: " <> show ty))
Util.genReturn (PrimEx DROP)
_ throw @"compilationError" (Type.InternalFault "binds do not match type")
_ throw @"compilationError" (Type.NotYetImplemented ("unpack: " <> show ty))

unpackDrop
m.
( HasState "stack" VStack.T m,
HasThrow "compilationError" CompilationError m
HasThrow "compilationError" Type.CompilationError m
)
[Maybe Symbol]
m ExpandedOp
unpackDrop binds = genReturn (foldDrop (fromIntegral (length (filter isJust binds))))
unpackDrop binds =
Util.genReturn (Util.foldDrop (fromIntegral (length (filter isJust binds))))

genSwitch
m.
( HasState "stack" VStack.T m,
HasThrow "compilationError" CompilationError m,
HasWriter "compilationLog" [CompilationLog] m
HasThrow "compilationError" Type.CompilationError m,
HasWriter "compilationLog" [Type.CompilationLog] m
)
T
m (ExpandedOp ExpandedOp ExpandedOp)
genSwitch Tbool = pure (\x y PrimEx (IF [y] [x])) -- TODO: Why flipped?
genSwitch (TOr _ _ _ _) = pure (\x y PrimEx (IF_LEFT [x] [y]))
genSwitch (TOption _) = pure (\x y PrimEx (IF_NONE [x] [y]))
genSwitch (TList _) = pure (\x y PrimEx (IF_CONS [x] [y]))
genSwitch ty = throw @"compilationError" (NotYetImplemented ("genSwitch: " <> show ty))
genSwitch ty =
throw @"compilationError" (Type.NotYetImplemented ("genSwitch: " <> show ty))
@@ -3,47 +3,46 @@
module Juvix.Backends.Michelson.Compilation.Lambda where

import Data.Maybe (fromJust) -- bad remove!
import Juvix.Backends.Michelson.Compilation.Term -- TODO fixme
import Juvix.Backends.Michelson.Compilation.Type
import Juvix.Backends.Michelson.Compilation.Types
import Juvix.Backends.Michelson.Compilation.Util
import qualified Juvix.Backends.Michelson.Compilation.Term as Term -- TODO fixme
import qualified Juvix.Backends.Michelson.Compilation.Type as Type
import qualified Juvix.Backends.Michelson.Compilation.Types as Types
import qualified Juvix.Backends.Michelson.Compilation.Util as Util
import qualified Juvix.Backends.Michelson.Compilation.VirtualStack as VStack
import Juvix.Backends.Michelson.Parameterisation
import qualified Juvix.Core.ErasedAnn as J
import qualified Juvix.Core.ErasedAnn as ErasedAnn
import Juvix.Library
import qualified Michelson.Untyped as M

termToMichelson
m.
( HasState "stack" VStack.T m,
HasThrow "compilationError" CompilationError m,
HasWriter "compilationLog" [CompilationLog] m
HasThrow "compilationError" Types.CompilationError m,
HasWriter "compilationLog" [Types.CompilationLog] m
)
Term
Types.Term
M.Type
m Op
m Types.Op
termToMichelson term paramTy = do
case term of
(J.Lam arg body, _, _) do
(ErasedAnn.Lam arg body, _, _) do
modify @"stack" (VStack.cons (VStack.varE arg Nothing, paramTy))
instr' termToInstrOuter body paramTy
let instr = M.SeqEx [instr', M.PrimEx (M.DIP [M.PrimEx M.DROP])]
modify @"stack" (\xs VStack.cons (VStack.car xs) (VStack.cdr (VStack.cdr xs)))
tell @"compilationLog" [TermToInstr body instr]
tell @"compilationLog" [Types.TermToInstr body instr]
pure instr
_ throw @"compilationError" (NotYetImplemented "must be a lambda function")
_ throw @"compilationError" (Types.NotYetImplemented "must be a lambda function")

termToInstrOuter
m.
( HasState "stack" VStack.T m,
HasThrow "compilationError" CompilationError m,
HasWriter "compilationLog" [CompilationLog] m
HasThrow "compilationError" Types.CompilationError m,
HasWriter "compilationLog" [Types.CompilationLog] m
)
Term
Types.Term
M.Type
m Op
m Types.Op
termToInstrOuter term ty = do
maybeOp termToInstr term ty
maybeOp Term.termToInstr term ty
case maybeOp of
Right op pure op
Left (VStack.LamPartial _ops _captures _args _body _) do
@@ -60,8 +59,8 @@ termToInstrOuter term ty = do
funcToLambda
m.
( HasState "stack" VStack.T m,
HasThrow "compilationError" CompilationError m,
HasWriter "compilationLog" [CompilationLog] m
HasThrow "compilationError" Types.CompilationError m,
HasWriter "compilationLog" [Types.CompilationLog] m
)
VStack.LamPartial
M.Type
@@ -86,7 +85,7 @@ funcToLambda (VStack.LamPartial ops captures args body lamTy) paramTy = do
currentStack get @"stack"
case VStack.lookup x currentStack of
Nothing
failWith
Util.failWith
( "free variable in lambda"
<> " doesn't exist"
)
@@ -104,7 +103,7 @@ funcToLambda (VStack.LamPartial ops captures args body lamTy) paramTy = do
pure (M.SeqEx [])
Just (VStack.Position p) do
let (Just type') = VStack.lookupType x currentStack
let inst = dupToFront (fromIntegral p)
let inst = Util.dupToFront (fromIntegral p)
modify @"stack" (VStack.cons (VStack.varE x Nothing, type'))
pure inst
)
@@ -120,7 +119,7 @@ funcToLambda (VStack.LamPartial ops captures args body lamTy) paramTy = do

numVarsInClosure = (length (captures <> args))

extraArgsWithTypes zip args . drop (length args) <$> typesFromPi lamTy
extraArgsWithTypes zip args . drop (length args) <$> Type.typesFromPi lamTy
let createExtraArgs =
(\(extra, extraType) (VStack.varE extra Nothing, extraType))
<$> extraArgsWithTypes
@@ -130,19 +129,19 @@ funcToLambda (VStack.LamPartial ops captures args body lamTy) paramTy = do
body termToInstrOuter body paramTy
put @"stack" current
-- Step 4: Pack up the captures.
packInstrs genReturn (pairN (realValues - 1))
packInstrs Util.genReturn (Util.pairN (realValues - 1))
-- Step 5: Determine the type of the lambda.
let capturesTypes =
(\x (x, fromJust (VStack.lookupType x current)))
<$> VStack.symbolsInT captures current
lTy
lamType capturesTypes extraArgsWithTypes
<$> returnTypeFromPi lamTy
Type.lamType capturesTypes extraArgsWithTypes
<$> Type.returnTypeFromPi lamTy
-- Step 6: Return the sequence of Michelson instructions, ending in `APPLY`.
let dipGen x =
case length (VStack.symbolsInT x current) of
0 M.SeqEx []
i M.PrimEx (M.DIP [unpackTupleN (pred i)])
i M.PrimEx (M.DIP [Util.unpackTupleN (pred i)])

dipArgs = dipGen args

@@ -157,7 +156,7 @@ funcToLambda (VStack.LamPartial ops captures args body lamTy) paramTy = do
lTy
( M.ValueLambda
( M.SeqEx
[ unpackTuple,
[ Util.unpackTuple,
dipArgs,
dipCurr
]

0 comments on commit 91a4107

Please sign in to comment.
You can’t perform that action at this time.