Emit JSON ABI files for contracts

runsol.sh

@@ -191,16 +191,12 @@ fi
 
 # Execute compilation pipeline
 echo "Compiling to hull..."
-if ! cabal run sol-core -- -f "$file"; then
+mkdir -p "$build_dir"
+if ! cabal run sol-core -- -f "$file" -o "$build_dir"; then
     echo "Error: sol-core compilation failed"
     exit 1
 fi
 
-mkdir -p build
-if ls ./output*.hull 1> /dev/null 2>&1; then
-    mv ./output*.hull build/
-fi
-
 echo "Generating Yul..."
 yule_args=("$hull" -o "$yulfile")
 if [[ "$create" == "false" ]]; then

sol-core.cabal

@@ -171,6 +171,7 @@ test-suite sol-core-tests
   -- cabal-fmt: expand test -Main
   other-modules:
     Cases
+    ContractAbiTests
     HullCases
     MatchCompilerTests
     ModuleTypeCheckTests

src/Solcore/Desugarer/ContractDispatch.hs

@@ -11,10 +11,13 @@
 module Solcore.Desugarer.ContractDispatch
   ( contractDispatchDesugarer,
     contractDispatchTopDecls,
+    writeContractAbis,
+    contractAbiJson,
   )
 where
 
-import Data.List (mapAccumL)
+import Control.Monad (forM_, unless)
+import Data.List (intercalate, mapAccumL)
 import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
 import Data.Set (Set)
 import Data.Set qualified as Set
@@ -23,6 +26,8 @@ import Language.Yul.QuasiQuote
 import Solcore.Backend.Mast
 import Solcore.Frontend.Syntax
 import Solcore.Primitives.Primitives (string, tupleExpFromList, tupleTyFromList, unit, word)
+import System.Directory (createDirectoryIfMissing)
+import System.FilePath ((<.>), (</>))
 
 contractDispatchDesugarer :: CompUnit Name -> CompUnit Name
 contractDispatchDesugarer (CompUnit ims topdecls) = CompUnit ims (contractDispatchTopDecls topdecls)
@@ -273,3 +278,159 @@ nameTypeName cname fname = Name ("DispatchNameTy_" <> nm cname <> "_" <> nm fnam
   where
     nm (Name s) = s
     nm (QualName _ s) = s
+
+nameStr :: Name -> String
+nameStr (Name s) = s
+nameStr (QualName _ s) = s
+
+--- ABI generation ---
+
+-- | Write a JSON ABI file for every contract among the given declarations.
+writeContractAbis :: FilePath -> [TopDecl Name] -> IO ()
+writeContractAbis outDir topdecls = do
+  let cs = [c | TContr c <- topdecls]
+  unless (null cs) (createDirectoryIfMissing True outDir)
+  forM_ cs $ \c ->
+    writeFile (outDir </> nameStr (name c) <.> "abi") (contractAbiJson c)
+
+-- | Render the JSON ABI description of a contract: an array of constructor,
+-- function and fallback descriptors.
+contractAbiJson :: Contract Name -> String
+contractAbiJson c =
+  renderJson (JArr (map abiEntryJson (contractAbiEntries c))) <> "\n"
+
+-- | A single ABI descriptor.
+data AbiEntry
+  = AbiFunction String [AbiParam] [AbiParam] String
+  | AbiConstructor [AbiParam] String
+  | AbiFallback String
+
+-- | An input or output entry. Tuple types carry their (recursive) components.
+data AbiParam = AbiParam
+  { abiParamName :: String,
+    abiParamType :: String,
+    abiParamComponents :: [AbiParam]
+  }
+
+contractAbiEntries :: Contract Name -> [AbiEntry]
+contractAbiEntries = mapMaybe entry . decls
+  where
+    entry (CConstrDecl con) =
+      Just (AbiConstructor (map abiParam (constrParams con)) (stateMutability (constrPayable con)))
+    entry (CFunDecl (FunDef isPublic sig _))
+      | sigName sig == fallbackName = Just (AbiFallback (stateMutability (sigPayable sig)))
+      | isPublic =
+          Just $
+            AbiFunction
+              (nameStr (sigName sig))
+              (map abiParam (sigParams sig))
+              (abiOutputs (sigReturn sig))
+              (stateMutability (sigPayable sig))
+      | otherwise = Nothing
+    entry _ = Nothing
+
+-- | The ABI @stateMutability@ field admits four values: @pure@, @view@,
+-- @nonpayable@ and @payable@. This prototype only tracks payability, not whether
+-- a function reads or writes state, so we can only distinguish @payable@ from
+-- @nonpayable@ and conservatively report the latter for everything else.
+stateMutability :: Bool -> String
+stateMutability payable = if payable then "payable" else "nonpayable"
+
+abiParam :: Param Name -> AbiParam
+abiParam (Typed _ pname t) = mkAbiParam (nameStr pname) t
+abiParam (Untyped _ pname) = AbiParam (nameStr pname) "" []
+
+-- | A comma-separated return list @(a, b, c)@ desugars to nested pairs; the ABI
+-- represents it as one output per element. A unit return has no outputs.
+abiOutputs :: Maybe Ty -> [AbiParam]
+abiOutputs Nothing = []
+abiOutputs (Just t)
+  | t == unit = []
+  | otherwise = map (mkAbiParam "") (flattenTuple t)
+
+flattenTuple :: Ty -> [Ty]
+flattenTuple (TyCon (Name "pair") [a, b]) = a : flattenTuple b
+flattenTuple t = [t]
+
+mkAbiParam :: String -> Ty -> AbiParam
+mkAbiParam pname t =
+  let (tyStr, comps) = abiTypeOf t
+   in AbiParam pname tyStr comps
+
+-- | Map a Solcore type to its canonical ABI type name and (for tuples) its
+-- component parameters. Memory/calldata are location qualifiers and are
+-- transparent to the ABI. The native @word@ maps to @uint256@; the remaining
+-- value-type names (uint256, address, bytes32, bool, bytes, string, ...) already
+-- match the Solidity ABI spelling and are passed through unchanged.
+abiTypeOf :: Ty -> (String, [AbiParam])
+abiTypeOf (TyCon (Name "memory") [t]) = abiTypeOf t
+abiTypeOf (TyCon (Name "calldata") [t]) = abiTypeOf t
+abiTypeOf t@(TyCon (Name "pair") [_, _]) =
+  ("tuple", map (mkAbiParam "") (flattenTuple t))
+abiTypeOf (TyCon (Name "word") []) = ("uint256", [])
+abiTypeOf (TyCon n _) = (nameStr n, [])
+abiTypeOf t = (show t, [])
+
+abiEntryJson :: AbiEntry -> Json
+abiEntryJson (AbiFunction fname ins outs mut) =
+  JObj
+    [ ("inputs", JArr (map abiParamJson ins)),
+      ("name", JStr fname),
+      ("outputs", JArr (map abiParamJson outs)),
+      ("stateMutability", JStr mut),
+      ("type", JStr "function")
+    ]
+abiEntryJson (AbiConstructor ins mut) =
+  JObj
+    [ ("inputs", JArr (map abiParamJson ins)),
+      ("stateMutability", JStr mut),
+      ("type", JStr "constructor")
+    ]
+abiEntryJson (AbiFallback mut) =
+  JObj
+    [ ("stateMutability", JStr mut),
+      ("type", JStr "fallback")
+    ]
+
+abiParamJson :: AbiParam -> Json
+abiParamJson p =
+  JObj $
+    [ ("internalType", JStr (abiParamType p)),
+      ("name", JStr (abiParamName p)),
+      ("type", JStr (abiParamType p))
+    ]
+      <> [("components", JArr (map abiParamJson (abiParamComponents p))) | not (null (abiParamComponents p))]
+
+--- Minimal JSON rendering ---
+
+data Json
+  = JStr String
+  | JArr [Json]
+  | JObj [(String, Json)]
+
+renderJson :: Json -> String
+renderJson = go 0
+  where
+    go _ (JStr s) = jsonString s
+    go _ (JArr []) = "[]"
+    go ind (JArr xs) =
+      "[\n"
+        <> intercalate ",\n" [indent (ind + 1) <> go (ind + 1) x | x <- xs]
+        <> "\n"
+        <> indent ind
+        <> "]"
+    go _ (JObj []) = "{}"
+    go ind (JObj kvs) =
+      "{\n"
+        <> intercalate ",\n" [indent (ind + 1) <> jsonString k <> ": " <> go (ind + 1) v | (k, v) <- kvs]
+        <> "\n"
+        <> indent ind
+        <> "}"
+    indent n = replicate (2 * n) ' '
+
+jsonString :: String -> String
+jsonString s = '"' : concatMap esc s <> "\""
+  where
+    esc '"' = "\\\""
+    esc '\\' = "\\\\"
+    esc c = [c]

src/Solcore/Pipeline/Options.hs

@@ -8,6 +8,8 @@ data Option
     optRootDir :: !FilePath,
     optImportDirs :: !String,
     optExternalLibs :: ![String],
+    optOutputDir :: !FilePath,
+    optEmitAbi :: !Bool,
     optNoSpec :: !Bool,
     optNoDesugarCalls :: !Bool,
     optNoMatchCompiler :: !Bool,
@@ -37,6 +39,8 @@ emptyOption path =
       optRootDir = ".",
       optImportDirs = "std",
       optExternalLibs = [],
+      optOutputDir = ".",
+      optEmitAbi = False,
       optNoSpec = False,
       optNoDesugarCalls = False,
       optNoMatchCompiler = False,
@@ -100,6 +104,17 @@ options =
               <> help "Register an external library root for @NAME imports."
           )
       )
+    <*> strOption
+      ( long "output-dir"
+          <> short 'o'
+          <> metavar "DIR"
+          <> value (optOutputDir stdOpt)
+          <> help "Directory for generated output files (default: current directory)"
+      )
+    <*> switch
+      ( long "abi"
+          <> help "Emit a JSON ABI file (<ContractName>.abi) for each contract"
+      )
     <*> switch
       ( long "no-specialise"
           <> short 'n'

src/Solcore/Pipeline/SolcorePipeline.hs

@@ -16,7 +16,7 @@ import Solcore.Backend.EmitHull (emitHull)
 import Solcore.Backend.Mast ()
 import Solcore.Backend.MastEval (defaultFuel, eliminateDeadCode, evalCompUnit)
 import Solcore.Backend.Specialise (specialiseCompUnit)
-import Solcore.Desugarer.ContractDispatch (contractDispatchTopDecls)
+import Solcore.Desugarer.ContractDispatch (contractDispatchTopDecls, writeContractAbis)
 import Solcore.Desugarer.DecisionTreeCompiler (matchCompiler, showWarning)
 import Solcore.Desugarer.FieldAccess (fieldDesugarTopDecls)
 import Solcore.Desugarer.IfDesugarer (ifDesugarer)
@@ -35,8 +35,9 @@ import Solcore.Frontend.TypeInference.SccAnalysis
 import Solcore.Frontend.TypeInference.TcEnv
 import Solcore.Frontend.TypeInference.TcModule
 import Solcore.Pipeline.Options (Option (..), argumentsParser, noDesugarOpt)
-import System.Directory (makeAbsolute)
+import System.Directory (createDirectoryIfMissing, makeAbsolute)
 import System.Exit (ExitCode (..), exitWith)
+import System.FilePath ((</>))
 import System.TimeIt qualified as TimeIt
 
 -- main compiler driver function
@@ -50,8 +51,10 @@ pipeline = do
       putStrLn err
       exitWith (ExitFailure 1)
     Right contracts -> do
+      let outDir = optOutputDir opts
+      unless (null contracts) (createDirectoryIfMissing True outDir)
       forM_ (zip [(1 :: Int) ..] contracts) $ \(i, c) -> do
-        let filename = "output" <> show i <> ".hull"
+        let filename = outDir </> "output" <> show i <> ".hull"
         putStrLn ("Writing to " ++ filename)
         writeFile filename (show c)
 
@@ -290,6 +293,16 @@ prepareInferenceDeclsForTypeInference opts emitOutput imps inferenceDecls = do
     putStrLn "Contract field access desugaring:"
     putStrLn $ prettyInferenceDecls accessed
 
+  -- Emit a JSON ABI file for each of the module's own contracts, named
+  -- <ContractName>.abi. Gated by --abi.
+  liftIO $ when (optEmitAbi opts) $ do
+    let localTopDecls =
+          [ moduleInferenceDeclTopDecl d
+            | d <- accessed,
+              moduleInferenceDeclSegment d == ModuleLocalDecl
+          ]
+    writeContractAbis (optOutputDir opts) localTopDecls
+
   -- contract dispatch generation
   dispatched <-
     liftIO $