Fix daml 1.0.1 bug

digital-asset · Gertjan423 · May 20, 2020 · Apr 7, 2020 · Apr 8, 2020 · Apr 9, 2020
commit aef855a893a402e62a348f8a0328cf2b8e869d2f
diff --git a/compiler/daml-lf-verify/src/DA/Daml/LF/Verify/Context.hs b/compiler/daml-lf-verify/src/DA/Daml/LF/Verify/Context.hs
@@ -249,6 +249,7 @@ expr2cid :: MonadEnv m ph
   -> m Cid
 expr2cid (EVar x) = return $ CidVar x
 expr2cid (ERecProj _ f (EVar x)) = return $ CidRec x f
+expr2cid (EStructProj f (EVar x)) = return $ CidRec x f
 expr2cid _ = throwError ExpectCid
 
 -- TODO: Could we alternatively just declare the variables that occur in the updates and drop the skolems?
@@ -745,6 +746,7 @@ recExpFields (EVar x) = do
     then return $ zip (head fss) (map (EVar . fieldName2VarName) $ head fss)
     else throwError $ UnboundVar x
 recExpFields (ERecCon _ fs) = return fs
+recExpFields (EStructCon fs) = return fs
 recExpFields (ERecUpd _ f recExp fExp) = do
   fs <- recExpFields recExp
   unless (isJust $ find (\(n, _) -> n == f) fs) (throwError $ UnknownRecField f)
@@ -754,6 +756,11 @@ recExpFields (ERecProj _ f e) = do
   case lookup f fields of
     Just e' -> recExpFields e'
     Nothing -> throwError $ UnknownRecField f
+recExpFields (EStructProj f e) = do
+  fields <- recExpFields e
+  case lookup f fields of
+    Just e' -> recExpFields e'
+    Nothing -> throwError $ UnknownRecField f
 recExpFields _ = throwError ExpectRecord
 
 instance SubstTm BoolExpr where

diff --git a/compiler/daml-lf-verify/src/DA/Daml/LF/Verify/Generate.hs b/compiler/daml-lf-verify/src/DA/Daml/LF/Verify/Generate.hs
@@ -189,6 +189,7 @@ genExpr = \case
   EVar name -> genForVar name
   EVal w -> genForVal w
   ERecProj tc f e -> genForRecProj tc f e
+  EStructProj f e -> genForStructProj f e
   ELocation _ expr -> genExpr expr
   EUpdate (UCreate tem arg) -> genForCreate tem arg
   EUpdate (UExercise tem ch cid par arg) -> genForExercise tem ch cid par arg
@@ -291,6 +292,28 @@ genForRecProj tc f body = do
         Just expr -> genExpr expr
         Nothing -> throwError $ UnknownRecField f
 
+-- | Analyse a struct projection expression.
+genForStructProj :: (GenPhase ph, MonadEnv m ph)
+  => FieldName
+  -- ^ The field which is projected.
+  -> Expr
+  -- ^ The record expression which is projected.
+  -> m (Output ph)
+genForStructProj f body = do
+  bodyOut <- genExpr body
+  case _oExpr bodyOut of
+    -- TODO: I think we can reduce duplication a bit more here
+    EVar x -> do
+      skol <- lookupRec x f
+      if skol
+        then return $ updateOutExpr (EStructProj f (EVar x)) bodyOut
+        else error ("Impossible: expected skolem record: " ++ show x ++ "." ++ show f)
+    expr -> do
+      fs <- recExpFields expr
+      case lookup f fs of
+        Just expr -> genExpr expr
+        Nothing -> throwError $ UnknownRecField f
+
 -- | Analyse a case expression.
 -- TODO: Atm only boolean cases are supported
 genForCase :: (GenPhase ph, MonadEnv m ph)

diff --git a/compiler/daml-lf-verify/src/DA/Daml/LF/Verify/Solve.hs b/compiler/daml-lf-verify/src/DA/Daml/LF/Verify/Solve.hs
@@ -72,6 +72,7 @@ instance ConstrExpr BoolExpr where
 instance ConstrExpr Expr where
   toCExp (EVar x) = CVar x
   toCExp (ERecProj _ f (EVar x)) = CVar $ recProj2Var x f
+  toCExp (EStructProj f (EVar x)) = CVar $ recProj2Var x f
   toCExp (ETmApp (ETmApp op e1) e2) = case op of
     (EBuiltin (BEEqual _)) -> CEq (toCExp e1) (toCExp e2)
     (EBuiltin BEAddInt64) -> CAdd (toCExp e1) (toCExp e2)