Add public visibility modifier for contract functions

src/Solcore/Backend/Specialise.hs

@@ -296,7 +296,7 @@ addMethodResolution cname ty fd = do
         Name s -> QualName cname s
   let name' = specName qname [ty]
   let funType = typeOfTcFunDef fd
-  let fd' = FunDef sig {sigName = name'} (funDefBody fd)
+  let fd' = FunDef (funIsPublic fd) sig {sigName = name'} (funDefBody fd)
   addResolution qname funType fd'
   debug ["+ addMethodResolution: ", show qname, " / ", show name', " : ", pretty funType]
 
@@ -415,10 +415,10 @@ specFunDef fd0 = withLocalState do
     Nothing -> do
       let sig' = applytv subst (funSignature fd)
       -- add a placeholder first to break loops
-      let placeholder = FunDef sig' []
+      let placeholder = FunDef (funIsPublic fd) sig' []
       addSpecialisation name' placeholder
       body' <- specBody (funDefBody fd)
-      let fd' = FunDef sig' {sigName = name'} body'
+      let fd' = FunDef (funIsPublic fd) sig' {sigName = name'} body'
       debug ["+ specFunDef: adding specialisation ", show name', " : ", pretty ty']
       addSpecialisation name' fd'
       return name'
@@ -633,7 +633,7 @@ schemeOfTcSignature sig@(Signature vs ps _n args (Just rt) _) =
 schemeOfTcSignature sig = error ("no return type in signature of: " ++ show (sigName sig))
 
 typeOfTcFunDef :: TcFunDef -> Ty
-typeOfTcFunDef (FunDef sig _) = typeOfTcSignature sig
+typeOfTcFunDef (FunDef _ sig _) = typeOfTcSignature sig
 
 pprRes :: Resolution -> Doc
 -- type Resolution = (Ty, FunDef Id)
@@ -785,7 +785,7 @@ instance HasTV (FunDef Id) where
     subst <- foldM addRenaming mempty (sigVars sig)
     let sig' = applytv subst sig
     let body' = applytv subst (funDefBody fd)
-    pure (FunDef sig' body', subst)
+    pure (FunDef (funIsPublic fd) sig' body', subst)
 
 addRenaming :: TVSubst -> Tyvar -> SM TVSubst
 addRenaming b a = do
@@ -842,7 +842,7 @@ toMastContractDecl (CMutualDecl ds) = MastCMutualDecl (map toMastContractDecl ds
 toMastContractDecl d = error $ "toMastContractDecl: unexpected " ++ show d
 
 toMastFunDef :: FunDef Id -> MastFunDef
-toMastFunDef (FunDef sig body) =
+toMastFunDef (FunDef _ sig body) =
   MastFunDef
     { mastFunName = sigName sig,
       mastFunParams = map toMastParam (sigParams sig),

src/Solcore/Desugarer/ContractDispatch.hs

@@ -63,7 +63,7 @@ findFallback c = listToMaybe [fd | CFunDecl fd <- decls c, isFallback fd]
 genNameDecls :: Contract Name -> Set (TopDecl Name)
 genNameDecls (Contract cname _ cdecls) = foldl go Set.empty cdecls
   where
-    go acc (CFunDecl (FunDef sig _))
+    go acc (CFunDecl (FunDef True sig _))
       | sigName sig == fallbackName = acc
       | otherwise =
           let dataTy = mkNameTy cname (sigName sig)
@@ -79,12 +79,12 @@ genMainFn addMain c@(Contract cname tys cdecls)
     cdecls'' = if hasConstructor cdecls then cdecls else cdecls ++ [defaultConstructor]
     cdecls' = Set.unions (map (transformCDecl cname) cdecls'')
     defaultConstructor = CConstrDecl (Constructor {constrParams = [], constrBody = []})
-    mainfn = FunDef (Signature [] [] "main" [] (Just unit) False) body
+    mainfn = FunDef False (Signature [] [] "main" [] (Just unit) False) body
     body = [StmtExp (Call Nothing (QualName "RunContract" "exec") [cdata])]
     cdata = Con "Contract" [methods, fallback]
     methods = tupleExpFromList (fmap mkMethod (mapMaybe unwrapSigs cdecls))
     fallback = case findFallback c of
-      Just (FunDef sig _) ->
+      Just (FunDef _ sig _) ->
         Con
           "Fallback"
           [ proxyExp (TyCon (if sigPayable sig then "Payable" else "NonPayable") []),
@@ -113,8 +113,8 @@ genMainFn addMain c@(Contract cname tys cdecls)
             ]
     mkMethod s = error $ "Internal Error: contract methods must be fully typed: " <> show s
 
-    -- skip the optional fallback function in the methods tuple
-    unwrapSigs (CFunDecl (FunDef s _))
+    -- skip the optional fallback function and non-public methods in the methods tuple
+    unwrapSigs (CFunDecl (FunDef True s _))
       | sigName s == fallbackName = Nothing
       | otherwise = Just s
     unwrapSigs _ = Nothing
@@ -136,7 +136,7 @@ transformConstructor contractName cons
   where
     params = constrParams cons
     argsTuple = (tupleTyFromList (mapMaybe getTy params))
-    initFun = CFunDecl (FunDef initSig (constrBody cons))
+    initFun = CFunDecl (FunDef False initSig (constrBody cons))
     initSig =
       Signature
         { sigVars = mempty,
@@ -186,7 +186,7 @@ transformConstructor contractName cons
     memoryT t = TyCon "memory" [t]
     memoryE e = Con "memory" [e]
     bytesT = TyCon "bytes" []
-    copyArgsFun = CFunDecl (FunDef copySig copyBody)
+    copyArgsFun = CFunDecl (FunDef False copySig copyBody)
 
     startSig =
       Signature
@@ -210,7 +210,7 @@ transformConstructor contractName cons
             return(0, size)
           }|]
       ]
-    startFun = CFunDecl (FunDef startSig startBody)
+    startFun = CFunDecl (FunDef False startSig startBody)
 
     isTyped (Typed {}) = True
     isTyped (Untyped {}) = False
@@ -236,7 +236,7 @@ mkNameInst (DataTy dname [] []) fname =
           instName = "SigString",
           paramsTy = [],
           mainTy = nameTy,
-          instFunctions = [FunDef sig body]
+          instFunctions = [FunDef False sig body]
         }
 mkNameInst dt _ = error ("Internal Error: unexpected name type structure: " <> show dt)
 

src/Solcore/Desugarer/DecisionTreeCompiler.hs

@@ -82,8 +82,8 @@ instance Compile (Constructor Id) where
     Constructor ps <$> compile bd
 
 instance Compile (FunDef Id) where
-  compile (FunDef sig bd) =
-    FunDef sig <$> pushCtx ("function " ++ pretty (sigName sig)) (compile bd)
+  compile (FunDef p sig bd) =
+    FunDef p sig <$> pushCtx ("function " ++ pretty (sigName sig)) (compile bd)
 
 instance Compile (Stmt Id) where
   compile (e1 := e2) =

src/Solcore/Desugarer/IndirectCall.hs

@@ -58,8 +58,8 @@ instance Desugar (Contract Name) where
     Contract n vs <$> desugar ds
 
 instance Desugar (FunDef Name) where
-  desugar (FunDef sig bdy) =
-    FunDef sig <$> desugar bdy
+  desugar (FunDef p sig bdy) =
+    FunDef p sig <$> desugar bdy
 
 instance Desugar (ContractDecl Name) where
   desugar (CFieldDecl fd) =

src/Solcore/Desugarer/UniqueTypeGen.hs

@@ -33,7 +33,7 @@ instance UniqueTypeGen (TopDecl Name) where
   uniqueTyGen _ = pure ()
 
 instance UniqueTypeGen (FunDef Name) where
-  uniqueTyGen (FunDef sig _) = uniqueTyGen sig
+  uniqueTyGen (FunDef _ sig _) = uniqueTyGen sig
 
 instance UniqueTypeGen (Signature Name) where
   uniqueTyGen sig =

src/Solcore/Frontend/Lexer/SolcoreLexer.hs

@@ -61,6 +61,7 @@ reservedWords =
     "function",
     "fallback",
     "payable",
+    "public",
     "constructor",
     "return",
     "lam",

src/Solcore/Frontend/Module/Loader.hs

@@ -496,8 +496,8 @@ stubContractDeclBody decl =
   decl
 
 stubFunDefBody :: FunDef -> FunDef
-stubFunDefBody (FunDef sig _body) =
-  FunDef sig []
+stubFunDefBody (FunDef p sig _body) =
+  FunDef p sig []
 
 moduleValidationTopDeclSegments :: ModuleGraph -> Mod.ModuleId -> Either String ([Import], [[TopDecl]])
 moduleValidationTopDeclSegments graph modulePath = do
@@ -1200,7 +1200,7 @@ isImportableTopDecl (TExportDecl _) = False
 isImportableTopDecl _ = True
 
 topDeclNames :: TopDecl -> [Name]
-topDeclNames (TFunDef (FunDef sig _)) = [sigName sig]
+topDeclNames (TFunDef (FunDef _ sig _)) = [sigName sig]
 topDeclNames (TSym (TySym n _ _)) = [n]
 topDeclNames (TClassDef (Class _ _ n _ _ _)) = [n]
 topDeclNames (TContr (Contract n _ _)) = [n]
@@ -1232,8 +1232,9 @@ qualifiedImportStubDecls graph (imp, modulePath) =
       stubDecls (QualName qualifier (show bindingName)) targetModule
 
 qualifyFunctionSignature :: Name -> FunDef -> FunDef
-qualifyFunctionSignature qualifier (FunDef sig body) =
+qualifyFunctionSignature qualifier (FunDef p sig body) =
   FunDef
+    p
     (sig {sigName = QualName qualifier (show (sigName sig))})
     body
 
@@ -1268,8 +1269,9 @@ renameTopDeclTypeRefs renameMap (TSym s) =
 renameTopDeclTypeRefs _ d = d
 
 renameFunDefTypeRefs :: Map Name Name -> FunDef -> FunDef
-renameFunDefTypeRefs renameMap (FunDef sig body) =
+renameFunDefTypeRefs renameMap (FunDef p sig body) =
   FunDef
+    p
     (renameSignatureTypeRefs renameMap sig)
     (renameBodyTypeRefs renameMap body)
 
@@ -1572,6 +1574,7 @@ stubType n =
 stubFunction :: Name -> FunDef
 stubFunction n =
   FunDef
+    False
     (Signature [] [] n [] Nothing False)
     []
 
@@ -1588,7 +1591,7 @@ validationImportedDecls graph (imp, modulePath) =
       Right []
 
 toValidationImportStub :: TopDecl -> Maybe TopDecl
-toValidationImportStub (TFunDef (FunDef sig _)) =
+toValidationImportStub (TFunDef (FunDef _ sig _)) =
   Just (TFunDef (stubFunction (sigName sig)))
 toValidationImportStub (TSym (TySym n _ _)) =
   Just (TSym (stubType n))
@@ -1829,7 +1832,7 @@ shadowImportedDecls localDecls =
         (seen', Just decl') -> (seen', decl' : acc)
         (seen', Nothing) -> (seen', acc)
 
-    filterDecl (termNames, typeNames, classNames, instDecls) d@(TFunDef (FunDef sig _))
+    filterDecl (termNames, typeNames, classNames, instDecls) d@(TFunDef (FunDef _ sig _))
       | sigName sig `elem` termNames = ((termNames, typeNames, classNames, instDecls), Nothing)
       | otherwise =
           ( (sigName sig : termNames, typeNames, classNames, instDecls),
@@ -1894,7 +1897,7 @@ instanceDeclHeadKey inst =
   (instDefault inst, instName inst, paramsTy inst, mainTy inst)
 
 topDeclTermNames :: TopDecl -> [Name]
-topDeclTermNames (TFunDef (FunDef sig _)) = [sigName sig]
+topDeclTermNames (TFunDef (FunDef _ sig _)) = [sigName sig]
 topDeclTermNames _ = []
 
 topDeclTypeNames :: TopDecl -> [Name]
@@ -1922,9 +1925,9 @@ renameTopDeclName oldName newName decl
   | oldName == newName = decl
   | otherwise =
       case decl of
-        TFunDef (FunDef sig body)
+        TFunDef (FunDef p sig body)
           | sigName sig == oldName ->
-              TFunDef (FunDef (sig {sigName = newName}) body)
+              TFunDef (FunDef p (sig {sigName = newName}) body)
         TSym sym@(TySym n _ _)
           | n == oldName ->
               TSym (sym {symName = newName})
@@ -1941,7 +1944,7 @@ renameTopDeclName oldName newName decl
           decl
 
 selectTopDeclForExportRef :: ExportedItemRef -> TopDecl -> Maybe TopDecl
-selectTopDeclForExportRef itemRef d@(TFunDef (FunDef sig _))
+selectTopDeclForExportRef itemRef d@(TFunDef (FunDef _ sig _))
   | exportedItemSourceName itemRef == sigName sig,
     exportedItemConstructors itemRef == Nothing =
       Just (renameTopDeclName (exportedItemSourceName itemRef) (exportedItemName itemRef) d)

src/Solcore/Frontend/Parser/Decl.hs

@@ -231,9 +231,10 @@ funDefP = try $ withSigPrefix funDefAfterPrefix
 
 funDefAfterPrefix :: [Ty] -> [Pred] -> Parser FunDef
 funDefAfterPrefix vars ctx = do
+  isPub <- option False (True <$ try (keyword "public"))
   sig <- signatureP vars ctx
   body <- braces bodyP
-  return (FunDef sig (implicitReturn body))
+  return (FunDef isPub sig (implicitReturn body))
 
 implicitReturn :: Body -> Body
 implicitReturn [StmtExp e] = [Return e]
@@ -252,7 +253,7 @@ fallbackDefAfterPrefix :: [Ty] -> [Pred] -> Parser FunDef
 fallbackDefAfterPrefix vars ctx = do
   sig <- fallbackSignatureP vars ctx
   body <- braces bodyP
-  return (FunDef sig (implicitReturn body))
+  return (FunDef False sig (implicitReturn body))
 
 fallbackSignatureP :: [Ty] -> [Pred] -> Parser Signature
 fallbackSignatureP vars ctx = do
@@ -314,6 +315,7 @@ contractDeclP =
     <$> dataP
       <|> CConstrDecl
     <$> constructorDeclP
+      <|> rejectPublicOnImplicitlyPublicP
       <|> withSigPrefix
         ( \vars ctx ->
             CFunDecl
@@ -322,6 +324,17 @@ contractDeclP =
       <|> CFieldDecl
     <$> fieldDeclP
 
+-- | `fallback` and `constructor` are implicitly public; reject an explicit
+-- `public` modifier on them with a clear error rather than a confusing
+-- parser failure.
+rejectPublicOnImplicitlyPublicP :: Parser a
+rejectPublicOnImplicitlyPublicP = do
+  kw <- try $ do
+    _ <- keyword "public"
+    _ <- optional (keyword "payable")
+    ("fallback" <$ keyword "fallback") <|> ("constructor" <$ keyword "constructor")
+  fail (kw ++ " is implicitly public; remove the 'public' keyword")
+
 fieldDeclP :: Parser Field
 fieldDeclP = do
   n <- Name <$> identifier

src/Solcore/Frontend/Pretty/SolcorePretty.hs

@@ -268,8 +268,8 @@ instance (Pretty a) => Pretty (Body a) where
   ppr = vcat . map ppr
 
 instance (Pretty a) => Pretty (FunDef a) where
-  ppr (FunDef sig bd) =
-    ppr sig
+  ppr (FunDef isPub sig bd) =
+    ((if isPub then text "public " else empty) <> ppr sig)
       <+> lbrace
       $$ nest 3 (vcat (map ppr bd))
       $$ rbrace

src/Solcore/Frontend/Pretty/TreePretty.hs

@@ -244,8 +244,8 @@ instance Pretty Body where
   ppr = vcat . map ppr
 
 instance Pretty FunDef where
-  ppr (FunDef sig bd) =
-    ppr sig
+  ppr (FunDef isPub sig bd) =
+    ((if isPub then text "public " else empty) <> ppr sig)
       <+> lbrace
       $$ nest 3 (vcat (map ppr bd))
       $$ rbrace

src/Solcore/Frontend/Syntax/Contract.hs

@@ -219,7 +219,8 @@ data Field a
 
 data FunDef a
   = FunDef
-  { funSignature :: Signature a,
+  { funIsPublic :: Bool,
+    funSignature :: Signature a,
     funDefBody :: Body a
   }
   deriving (Eq, Ord, Show, Data, Typeable)

src/Solcore/Frontend/Syntax/NameResolution.hs

@@ -116,15 +116,15 @@ topLevelTypeNames = concatMap collect
 topLevelTermNames :: [S.TopDecl] -> [Name]
 topLevelTermNames = concatMap collect
   where
-    collect (S.TFunDef (S.FunDef sig _)) = [S.sigName sig]
+    collect (S.TFunDef (S.FunDef _ sig _)) = [S.sigName sig]
     collect (S.TDataDef (S.DataTy tyCon _ cons)) =
       map (qualifiedConstructorName tyCon . S.constrName) cons
     collect _ = []
 
 contractTermNames :: [S.ContractDecl] -> [Name]
 contractTermNames = concatMap collect
   where
-    collect (S.CFunDecl (S.FunDef sig _)) = [S.sigName sig]
+    collect (S.CFunDecl (S.FunDef _ sig _)) = [S.sigName sig]
     collect (S.CDataDecl (S.DataTy tyCon _ cons)) =
       map (qualifiedConstructorName tyCon . S.constrName) cons
     collect _ = []
@@ -219,7 +219,7 @@ addContractDecl (S.CDataDecl (S.DataTy n _ cons)) =
     mapM_ (addDataCon n . S.constrName) cons
 addContractDecl (S.CFieldDecl (S.Field n _ _)) =
   addField n
-addContractDecl (S.CFunDecl (S.FunDef sig _)) =
+addContractDecl (S.CFunDecl (S.FunDef _ sig _)) =
   addFunctionName (S.sigName sig)
 addContractDecl _ = pure ()
 
@@ -338,7 +338,7 @@ instance Resolve S.PragmaStatus where
 instance Resolve S.FunDef where
   type Result S.FunDef = FunDef Name
 
-  resolve f@(S.FunDef (S.Signature vs ctx n ps mt pay) bds) =
+  resolve f@(S.FunDef isPub (S.Signature vs ctx n ps mt pay) bds) =
     do
       let ns = map tyconName vs
       withLocalCtx $ do
@@ -351,7 +351,7 @@ instance Resolve S.FunDef where
         bds' <- resolve bds `wrapError` f
         let vs' = map TVar ns
             sig = Signature vs' ctx' n ps' mt' pay
-        pure (FunDef sig bds')
+        pure (FunDef isPub sig bds')
 
 instance Resolve S.Stmt where
   type Result S.Stmt = Stmt Name
@@ -928,7 +928,7 @@ addTopDecl :: S.TopDecl -> Env -> Env
 addTopDecl (S.TContr (S.Contract n _ _)) env =
   addQualifiedModules n $
     env {typeEnv = Map.insert n TContract (typeEnv env)}
-addTopDecl (S.TFunDef (S.FunDef sig _)) env =
+addTopDecl (S.TFunDef (S.FunDef _ sig _)) env =
   addQualifiedModules (S.sigName sig) $
     env {scopeEnv = Map.insert (S.sigName sig) TFunction (scopeEnv env)}
 addTopDecl (S.TClassDef (S.Class _ _ n _ _ sigs)) env =

src/Solcore/Frontend/Syntax/SyntaxTree.hs

@@ -218,7 +218,8 @@ data Field
 
 data FunDef
   = FunDef
-  { funSignature :: Signature,
+  { funIsPublic :: Bool,
+    funSignature :: Signature,
     funDefBody :: Body
   }
   deriving (Eq, Ord, Show, Data, Typeable)