From 65ba2f2a4bd6cfd4dd2fb714f105d3646a5cf7e5 Mon Sep 17 00:00:00 2001 From: Marcin Benke Date: Wed, 31 Dec 2025 15:31:59 +0100 Subject: [PATCH 1/8] Add RunSol Haskell executable and reorganize yule modules MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Implement a new RunSol Haskell program (app/RunSol.hs) that replicates the functionality of runsol.sh while integrating sol-core and yule compilation directly as library functions instead of external processes. Key changes: - Move yule modules from yule/ to src/Yule/ with proper namespacing - Yule/Translate.hs, Yule/TM.hs, Yule/Compress.hs, Yule/Builtins.hs, Yule/Locus.hs, Yule/Options.hs - Expose Yule.* modules in library for use by RunSol - Create new runsol executable that: - Calls compile() directly for sol-core compilation - Calls translateObject() directly for yule translation - Uses aeson for JSON processing (instead of jq) - Calls external processes for solc, evm, cast - Supports all runsol.sh command-line options - Update yule/Main.hs to use new Yule.* module imports - Update sol-core.cabal with Yule.* exports and runsol executable Benefits: - Faster execution (no process spawning for sol-core and yule) - Better error handling through Haskell types - Single executable instead of shell script - Type safety through direct function calls - Better module organization with Yule namespace 🤖 Generated with Claude Code Co-Authored-By: Claude Haiku 4.5 --- app/RunSol.hs | 375 +++++++++++++++++++++++++++++++++++++++ sol-core.cabal | 22 ++- src/Yule/Builtins.hs | 18 ++ src/Yule/Compress.hs | 98 +++++++++++ src/Yule/Locus.hs | 24 +++ src/Yule/Options.hs | 68 ++++++++ src/Yule/TM.hs | 135 ++++++++++++++ src/Yule/Translate.hs | 396 ++++++++++++++++++++++++++++++++++++++++++ yule/Main.hs | 24 +-- 9 files changed, 1147 insertions(+), 13 deletions(-) create mode 100644 app/RunSol.hs create mode 100644 src/Yule/Builtins.hs create mode 100644 src/Yule/Compress.hs create mode 100644 src/Yule/Locus.hs create mode 100644 src/Yule/Options.hs create mode 100644 src/Yule/TM.hs create mode 100644 src/Yule/Translate.hs diff --git a/app/RunSol.hs b/app/RunSol.hs new file mode 100644 index 000000000..ed99c2b24 --- /dev/null +++ b/app/RunSol.hs @@ -0,0 +1,375 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} +module Main where + +import Control.Monad (when, unless) +import Data.List (isPrefixOf) +import Data.Maybe (fromMaybe, isJust) +import System.Exit (exitFailure, exitSuccess, ExitCode(..)) +import System.FilePath (takeDirectory, takeBaseName, dropExtension, (), (<.>)) +import System.Process (readProcessWithExitCode, callProcess) +import System.Directory (createDirectoryIfMissing, listDirectory, removeFile) +import qualified Data.ByteString.Lazy as BL +import qualified Data.Aeson as A +import Options.Applicative +import Text.Read (readMaybe) + +import Solcore.Pipeline.SolcorePipeline (compile) +import Solcore.Pipeline.Options (Option(..)) +import qualified Language.Core as Core +import Yule.Translate (translateObject) +import Yule.TM (runTM, CEnv) +import Yule.Compress (compress) +import qualified Yule.Options as YuleOpts +import Common.Pretty (render, ppr) +import Language.Yul (YulObject(..)) + +-- ============================================================================ +-- Data Types +-- ============================================================================ + +data RunSolOptions = RunSolOptions + { inputFile :: FilePath + , buildDir :: FilePath + , runtimeCalldataSig :: Maybe String + , runtimeCalldataArgs :: [String] + , runtimeRawCalldata :: Maybe String + , runtimeCallvalue :: Maybe String + , debugRuntime :: Bool + , shouldCreate :: Bool + , createArgumentsSig :: Maybe String + , createArgs :: [String] + , createRawArgs :: Maybe String + , createCallvalue :: Maybe String + , debugCreate :: Bool + } deriving (Show, Eq) + +data EVMResult = EVMResult + { evmOutput :: String + , evmError :: Maybe String + , evmExitCode :: ExitCode + } deriving (Show) + +-- ============================================================================ +-- Command-Line Argument Parser +-- ============================================================================ + +optionsParser :: Parser RunSolOptions +optionsParser = RunSolOptions + <$> argument str + (metavar "FILE" <> help "Input .solc file") + <*> strOption + (long "build-dir" + <> value "build" + <> showDefault + <> help "Build directory") + <*> optional (strOption + (long "runtime-calldata" + <> metavar "SIG" + <> help "Runtime function signature for calldata generation")) + <*> many (argument str (metavar "ARGS..." <> help "Runtime calldata arguments")) + <*> optional (strOption + (long "runtime-raw-calldata" + <> metavar "HEX" + <> help "Raw hex calldata for runtime")) + <*> optional (strOption + (long "runtime-callvalue" + <> metavar "VALUE" + <> help "Callvalue for runtime execution (in wei)")) + <*> switch + (long "debug-runtime" + <> help "Debug runtime execution") + <*> flag True False + (long "no-create" + <> help "Skip contract creation phase") + <*> optional (strOption + (long "create-arguments" + <> metavar "SIG" + <> help "Constructor signature for calldata generation")) + <*> many (argument str (metavar "ARGS..." <> help "Create calldata arguments")) + <*> optional (strOption + (long "create-raw-arguments" + <> metavar "HEX" + <> help "Raw hex calldata for constructor")) + <*> optional (strOption + (long "create-callvalue" + <> metavar "VALUE" + <> help "Callvalue for create execution (in wei)")) + <*> switch + (long "debug-create" + <> help "Debug create execution") + +parseOptions :: IO RunSolOptions +parseOptions = execParser opts + where + opts = info (optionsParser <**> helper) + ( fullDesc + <> progDesc "Solcore pipeline runner" + <> header "runsol - Run solc compiler with evm execution" ) + +-- ============================================================================ +-- Compilation Functions +-- ============================================================================ + +-- Compile .solc to Core using the pipeline +compileSolcoreToCore :: FilePath -> IO [Core.Object] +compileSolcoreToCore file = do + let opts = Option + { fileName = file + , optImportDirs = "std" + , optNoSpec = False + , optNoDesugarCalls = False + , optNoMatchCompiler = False + , optNoIfDesugar = False + , optNoGenDispatch = False + , optVerbose = False + , optDumpAST = False + , optDumpEnv = False + , optDumpDispatch = False + , optDumpDS = False + , optDumpDF = False + , optDumpSpec = False + , optDumpCore = False + , optDebugSpec = False + , optDebugCore = False + , optTiming = False + } + result <- compile opts + case result of + Left err -> do + putStrLn $ "Error during compilation: " ++ err + exitFailure + Right objs -> return objs + +-- Translate Core to Yul using integrated yule +translateCoreToYul :: Core.Object -> IO YulObject +translateCoreToYul coreObj = do + let yuleOpts = YuleOpts.Options + { YuleOpts.input = "" + , YuleOpts.contract = "Output" + , YuleOpts.output = "" + , YuleOpts.verbose = False + , YuleOpts.debug = False + , YuleOpts.compress = False + , YuleOpts.wrap = False + , YuleOpts.runOnce = False + } + result <- runTM yuleOpts (translateObject coreObj) + return result + +-- Compile Yul to bytecode using solc +compileToBytecode :: FilePath -> YulObject -> IO String +compileToBytecode outputFile yulObj = do + let yulSource = render (ppr yulObj) + -- Write Yul to temporary file + let yulFile = dropExtension outputFile <.> "yul" + writeFile yulFile yulSource + -- Call solc + (exitCode, stdout, stderr) <- readProcessWithExitCode + "solc" + ["--strict-assembly", "--bin", "--optimize", yulFile] + "" + case exitCode of + ExitSuccess -> do + let bytecode = last (lines stdout) + putStrLn $ "Hex output: " ++ outputFile + writeFile outputFile bytecode + return bytecode + ExitFailure code -> do + putStrLn $ "Error: solc compilation failed with code " ++ show code + putStrLn $ "stderr: " ++ stderr + exitFailure + +-- ============================================================================ +-- Process Execution Helpers +-- ============================================================================ + +-- Call cast to encode calldata +castCalldataEncode :: String -> [String] -> IO String +castCalldataEncode sig args = do + (exitCode, stdout, stderr) <- readProcessWithExitCode + "cast" + ("calldata" : sig : args) + "" + case exitCode of + ExitSuccess -> return (head (lines stdout)) + ExitFailure code -> do + putStrLn $ "Error: cast calldata failed with code " ++ show code + putStrLn $ "stderr: " ++ stderr + exitFailure + +-- Call cast to decode output +castAbiDecode :: String -> String -> IO String +castAbiDecode sig hexOutput = do + (exitCode, stdout, stderr) <- readProcessWithExitCode + "cast" + ["abi-decode", sig, hexOutput] + "" + case exitCode of + ExitSuccess -> return (unlines (lines stdout)) + ExitFailure code -> do + putStrLn $ "Error: cast abi-decode failed with code " ++ show code + putStrLn $ "stderr: " ++ stderr + exitFailure + +-- Build EVM command and execute create phase +executeCreate :: RunSolOptions -> String -> FilePath -> IO (String, Maybe String) +executeCreate opts bytecode buildDir = do + putStrLn "Executing create phase..." + let traceFile = buildDir "trace.create.jsonl" + let poststateFile = buildDir "create.poststate.json" + + -- Prepare bytecode with constructor args if provided + let hexFileWithArgs = if isJust (createArgumentsSig opts) + then case createArgumentsSig opts of + Just sig -> do + args <- castCalldataEncode sig (createArgs opts) + return $ bytecode ++ drop 2 args -- drop "0x" prefix + Nothing -> return bytecode + else if isJust (createRawArgs opts) + then return $ bytecode ++ drop 2 (fromMaybe "" (createRawArgs opts)) + else return bytecode + + bytecodeWithArgs <- hexFileWithArgs + + -- Build evm command + let evmCmd = ["evm", "run"] + ++ ["--trace", "--trace.nomemory=false", "--trace.noreturndata=false"] + ++ ["--create", "--dump", "--codefile", "-"] + ++ (case createCallvalue opts of + Just v -> ["--value", v] + Nothing -> []) + + -- Execute evm + (exitCode, stdout, stderr) <- readProcessWithExitCode + "evm" + (tail evmCmd) -- drop "evm" command + bytecodeWithArgs + + let output = if exitCode == ExitSuccess then stdout else stderr + + -- Extract post-state JSON from output + let stateLines = dropWhile (not . ("{" `isPrefixOf`)) (lines output) + + when (debugCreate opts) $ + putStrLn $ "Create output: " ++ output + + let result = if null stateLines then "" else unlines stateLines + let error = if exitCode == ExitSuccess then Nothing else Just result + + -- Save trace and post-state + writeFile traceFile output + + return (result, error) + +-- Build EVM command and execute runtime phase +executeRuntime :: RunSolOptions -> String -> FilePath -> IO (String, Maybe String) +executeRuntime opts bytecode buildDir = do + putStrLn "Executing runtime phase..." + let traceFile = buildDir "trace.runtime.jsonl" + + -- Prepare runtime calldata if provided + let inputOpt = case runtimeCalldataSig opts of + Just sig -> do + calldata <- castCalldataEncode sig (runtimeCalldataArgs opts) + return ["--input", calldata] + Nothing -> case runtimeRawCalldata opts of + Just hex -> return ["--input", hex] + Nothing -> return [] + + inputArgs <- inputOpt + + -- Build evm command + let evmCmd = ["evm", "run"] + ++ ["--trace", "--trace.nomemory=false", "--trace.noreturndata=false"] + ++ ["--codefile", "-"] + ++ inputArgs + ++ (case runtimeCallvalue opts of + Just v -> ["--value", v] + Nothing -> []) + + -- Execute evm + (exitCode, stdout, stderr) <- readProcessWithExitCode + "evm" + (tail evmCmd) -- drop "evm" command + bytecode + + let output = if exitCode == ExitSuccess then stdout else stderr + + when (debugRuntime opts) $ + putStrLn $ "Runtime output: " ++ output + + -- Save trace + writeFile traceFile output + + let result = if exitCode == ExitSuccess then stdout else stderr + let error = if exitCode == ExitSuccess then Nothing else Just result + + return (result, error) + +-- ============================================================================ +-- Main Function +-- ============================================================================ + +main :: IO () +main = do + opts <- parseOptions + + -- Create build directory + createDirectoryIfMissing True (buildDir opts) + + putStrLn $ "Processing: " ++ inputFile opts + + -- Step 1: Compile .solc to Core + putStrLn "Compiling to core..." + coreObjs <- compileSolcoreToCore (inputFile opts) + + when (null coreObjs) $ do + putStrLn "Error: No core objects generated" + exitFailure + + let coreObj = head coreObjs + + -- Step 2: Translate Core to Yul + putStrLn "Generating Yul..." + yulObj <- translateCoreToYul coreObj + + -- Step 3: Compile Yul to bytecode + putStrLn "Compiling to bytecode..." + let base = dropExtension (takeBaseName (inputFile opts)) + let hexFile = buildDir opts base <.> "hex" + bytecode <- compileToBytecode hexFile yulObj + + -- Step 4: Execute create phase (if enabled) + when (shouldCreate opts) $ do + (createResult, createError) <- executeCreate opts bytecode (buildDir opts) + + case createError of + Nothing -> do + putStrLn "Creation successful" + unless (null createResult) $ + putStrLn $ "returndata: 0x" ++ createResult + Just err -> do + putStrLn $ "Creation failed: " ++ err + unless (null createResult) $ + putStrLn $ "returndata: 0x" ++ createResult + + -- Step 5: Execute runtime phase + (runtimeResult, runtimeError) <- executeRuntime opts bytecode (buildDir opts) + + case runtimeError of + Nothing -> do + putStrLn "Execution successful" + case runtimeCalldataSig opts of + Just sig -> do + when (not (null runtimeResult)) $ do + decoded <- castAbiDecode sig ("0x" ++ runtimeResult) + putStrLn $ "Decoded output: " ++ decoded + Nothing -> do + unless (null runtimeResult) $ + putStrLn $ "returndata: 0x" ++ runtimeResult + Just err -> do + putStrLn $ "Execution failed: " ++ err + unless (null runtimeResult) $ + putStrLn $ "returndata: 0x" ++ runtimeResult + exitFailure diff --git a/sol-core.cabal b/sol-core.cabal index 4666afc27..a53b74c22 100644 --- a/sol-core.cabal +++ b/sol-core.cabal @@ -104,6 +104,12 @@ library Language.Yul Language.Yul.Parser Language.Yul.QuasiQuote + Yule.Translate + Yule.TM + Yule.Compress + Yule.Builtins + Yule.Locus + Yule.Options Common.LightYear Common.Monad Common.Pretty @@ -132,7 +138,6 @@ executable yule PatternSynonyms BlockArguments ImportQualifiedPost - other-modules: Locus, Options, TM, Translate, Builtins, Compress build-depends: base ^>=4.19.1.0, pretty >= 1.1, containers >= 0.6, @@ -142,6 +147,21 @@ executable yule optparse-applicative >= 0.18, sol-core +executable runsol + import: common-opts + main-is: RunSol.hs + hs-source-dirs: app + build-depends: + sol-core, + process, + aeson, + temporary, + bytestring + build-tool-depends: alex:alex, happy:happy + ghc-options: -O1 + default-extensions: + LambdaCase + test-suite sol-core-tests import: common-opts type: exitcode-stdio-1.0 diff --git a/src/Yule/Builtins.hs b/src/Yule/Builtins.hs new file mode 100644 index 000000000..fcd978f13 --- /dev/null +++ b/src/Yule/Builtins.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE OverloadedStrings #-} +module Yule.Builtins(yulBuiltins, revertStmt) where +import Data.String +import Language.Yul + +yulBuiltins :: [YulStmt] +yulBuiltins = [] + +revertStmt :: String -> [YulStmt] +revertStmt s = [ YExp $ YCall "mstore" [yulInt 0, YLit (YulString s)] + , YExp $ YCall "revert" [yulInt 0, yulIntegral (length s)] + ] + +{- +poisonBuiltin :: [YulStmt] +poisonBuiltin = + [ YFun "$poison" [] (YReturns ["_dummy"]) (revertStmt "Dying from poison!") ] +-} diff --git a/src/Yule/Compress.hs b/src/Yule/Compress.hs new file mode 100644 index 000000000..3c9f0f1ed --- /dev/null +++ b/src/Yule/Compress.hs @@ -0,0 +1,98 @@ +module Yule.Compress where +import Language.Core + +class Compress a where + compress :: a -> a + +instance Compress Type where + compress (TNamed n t@(TSum _ _)) = foldSum t + compress t = t + +foldSum :: Type -> Type +foldSum t = TSumN (go t) where + go :: Type -> [Type] + go (TSum t1 t2) = go t1 ++ go t2 + go t = [t] + +-- foldIns :: Type -> Expr -> Expr +-- treat expressions of the form: +-- - inl(inr*(e)) e.g. inl(inr(e)) becomes in(1)(e) +-- inl(e) becomes in(0)(e) +-- - inr+(e) e.g. inr(inr(e)) becomes in(2)(e) +-- Note: for complex types, such as Option{(unit + Option{(unit + word)})} +-- inr(inr(x)) becomes in1(in1(x)) rather than in2(x) +compressInjections ty@(TSumN ts) e = go 0 e where + arity = length ts + go k e | k == arity-1 = EInK k ty (compress e) + go k (EInr _ e) = go (k+1) e + go k (EInl _ e) = EInK k ty e + -- go k e = EInK k ty (compress e) + +{- Compress match statements + match e with { + inl(x) => s1 + inr(y) => s2 } + becomes + match e with { + in1(x) => s1 + in2(x) => s2 } + even if s2 is a match statement + + match e with { + inl(x) => s1 + inr(y) => match y with { + } + } + + To do this we need to know the scrutinee type +-} +compressMatch :: Type -> Stmt -> Stmt +compressMatch (TSumN ts) top@(SMatch ty e0 _alts) = SMatch ty' e' (go 0 top) where + ty' = compress ty + e' = compress e0 + arity = length ts + alt = ConAlt + go k (SMatch (TNamed _n nty) e alts) = go k (SMatch nty e alts) + go k (SMatch TSum{} _e [ConAlt CInl ln left, ConAlt CInr rn right]) + -- last two alternatives in the chain + | k == arity-2 = [alt (CInK k )ln left', alt (CInK (k+1)) rn right'] + -- not reached the end of the chain yet + | otherwise = firstAlt:rest + where + left' = compress left + right' = compress right + firstAlt = alt (CInK k) ln left' + rest = go (k+1) (SBlock right) + go k (SBlock [s]) = go k s + go k s = error $ concat["compressMatch unimplemented for k=",show k," stmt: ", show s] +compressMatch TWord top = top +compressMatch cty top = error $ concat["compressMatch unimplemented for cty=",show cty," stmt: ", show top] + +instance Compress Contract where + compress c = c { ccStmts = map compress (ccStmts c) } + +instance Compress a => Compress [a] where + compress = map compress + +instance Compress Stmt where + compress (SFunction n args t stmts) = SFunction n + (compress args) + (compress t) + (map compress stmts) + compress (SReturn e) = SReturn (compress e) + compress (SMatch t e alts) = compressMatch (compress t) (SMatch t e alts) + compress s = s + +instance Compress Arg where + compress (TArg n t) = TArg n (compress t) + +instance Compress Expr where + compress e@(EInl ty _) = compressInjections (compress ty) e + compress e@(EInr ty _) = compressInjections (compress ty) e + compress (ECall n es) = ECall n (compress es) + compress e = e + +instance Compress Object where + compress (Object name code inners) = Object name code' inners' where + code' = compress code + inners' = compress inners diff --git a/src/Yule/Locus.hs b/src/Yule/Locus.hs new file mode 100644 index 000000000..4aa1c0da3 --- /dev/null +++ b/src/Yule/Locus.hs @@ -0,0 +1,24 @@ +module Yule.Locus where +import Data.String +{- +Location tree with addresses a: +- location for Int is a single cell +- location for pair is a pair of locations for components +- location for sum is a location for tag and locations for payload +-} +data LocTree a + = LocWord Integer -- int literal + | LocBool Bool -- bool literal + | LocStack a -- stack location + | LocNamed String -- named location (e.g. argument/result) + | LocSeq [LocTree a] -- sequence of locations + | LocEmpty Int -- empty location of given size + deriving (Eq, Show) + +pattern LocPair a b = LocSeq [a, b] +pattern LocUnit = LocSeq [] + +type Location = LocTree Int + +stkLoc :: IsString name => Int -> name +stkLoc i = fromString("_v" ++ show i) diff --git a/src/Yule/Options.hs b/src/Yule/Options.hs new file mode 100644 index 000000000..4da1962bc --- /dev/null +++ b/src/Yule/Options.hs @@ -0,0 +1,68 @@ +module Yule.Options where + +import Options.Applicative + +data Options = Options + { input :: FilePath + , contract :: String + , output :: FilePath + , verbose :: Bool + , debug :: Bool + , compress :: Bool + , wrap :: Bool + , runOnce :: Bool + } deriving Show + +optionsParser :: Parser Options +optionsParser = Options + <$> argument str + ( metavar "FILE" + <> help "Input file" ) + <*> strOption + ( long "contract" + <> short 'c' + <> metavar "NAME" + <> help "Contract name" + <> value "Output" + <> showDefault + ) + <*> strOption + ( long "output" + <> short 'o' + <> metavar "FILE" + <> help "Output file" + <> value "Output.sol" + <> showDefault + ) + <*> switch + ( long "verbose" + <> short 'v' + <> help "Verbosity level" + ) + <*> switch + ( long "debug" + <> short 'd' + <> help "Diagnostic output" + ) + <*> switch + ( long "compress" + <> short 'O' + <> help "Compress sums (experimental)" + ) + <*> switch + ( long "wrap" + <> short 'w' + <> help "Wrap Yul in a Solidity contract" + ) + <*> switch + ( long "nodeploy" + <> help "Output code to be run once, without the deployment code" + ) + +parseOptions :: IO Options +parseOptions = execParser opts + where + opts = info (optionsParser <**> helper) + ( fullDesc + <> progDesc "Compile a Core program to Yul" + <> header "yule - experiments with Yul codegen" ) diff --git a/src/Yule/TM.hs b/src/Yule/TM.hs new file mode 100644 index 000000000..ce9de12b0 --- /dev/null +++ b/src/Yule/TM.hs @@ -0,0 +1,135 @@ +module Yule.TM +( TM +, runTM +, CEnv(..) +--, module RIO +, module Yule.Locus +, FunInfo(..) +, getCounter +, setCounter +, freshId +, lookupVar +, insertVar +, lookupFun +, insertFun +, getVarEnv +, putVarEnv +, withLocalEnv +, debug +) where +import Common.Monad +import Common.RIO +import Control.Monad(when) +import qualified Data.Map as Map +import Data.Map(Map) + +import Yule.Locus +import Language.Core qualified as Core +import qualified Yule.Options +import Yule.Options(Options) + +type VarEnv = Map String Location +type FunEnv = Map String FunInfo +data FunInfo = FunInfo { fun_args :: [Core.Type], fun_result :: Core.Type} +data CEnv = CEnv + { env_counter :: IORef Int + , env_vars :: IORef VarEnv + , env_funs :: IORef FunEnv + , env_options :: Options + } + +type TM a = RIO CEnv a + +runTM :: Options -> TM a -> IO a +runTM options m = do + counter <- newIORef 0 + vars <- newIORef Map.empty + funs <- newIORef (Map.fromList builtinFuns) + runRIO m (CEnv counter vars funs options) + +getCounter :: TM Int +getCounter = reader env_counter >>= load + +setCounter :: Int -> TM () +setCounter n = reader env_counter >>= flip store n + +getDebug :: TM Bool +getDebug = reader (Yule.Options.debug . env_options) + +whenDebug m = do + debugp <- getDebug + when debugp m + +debug :: [String] -> TM () +debug msg = whenDebug $ writes msg + +freshId :: TM Int +freshId = do + counter <- reader env_counter + n <- load counter + store counter (n+1) + return n + +lookupVar :: String -> TM Location +lookupVar x = do + vars <- getVarEnv + case Map.lookup x vars of + Just n -> return n + Nothing -> error ("Variable not found: " ++ x) + +insertVar :: String -> Location -> TM () +insertVar x n = do + vars <- reader env_vars + update vars (Map.insert x n) + +lookupFun :: String -> TM FunInfo +lookupFun f = do + funs <- getFunEnv + case Map.lookup f funs of + Just n -> return n + Nothing -> error ("Function not found: " ++ f) + +insertFun :: String -> FunInfo -> TM () +insertFun f n = do + funs <- reader env_funs + update funs (Map.insert f n) + +getVarEnv :: TM VarEnv +getVarEnv = load =<< reader env_vars + +putVarEnv :: VarEnv -> TM () +putVarEnv m = do + vars <- reader env_vars + store vars m + +getFunEnv :: TM FunEnv +getFunEnv = load =<< reader env_funs + +putFunEnv :: FunEnv -> TM () +putFunEnv m = do + funs <- reader env_funs + store funs m + +withLocalEnv :: TM a -> TM a +withLocalEnv m = do + vars <- getVarEnv + funs <- getFunEnv + x <- m + putVarEnv vars + putFunEnv funs + return x + +builtinFuns :: [(String, FunInfo)] +builtinFuns = + [ ("stop", FunInfo [] Core.TUnit) + , ("add", FunInfo [Core.TWord, Core.TWord] Core.TWord) + , ("mul", FunInfo [Core.TWord, Core.TWord] Core.TWord) + , ("sub", FunInfo [Core.TWord, Core.TWord] Core.TWord) + , ("div", FunInfo [Core.TWord, Core.TWord] Core.TWord) + , ("sdiv", FunInfo [Core.TWord, Core.TWord] Core.TWord) + , ("mod", FunInfo [Core.TWord, Core.TWord] Core.TWord) + , ("smod", FunInfo [Core.TWord, Core.TWord] Core.TWord) + , ("addmod", FunInfo [Core.TWord, Core.TWord, Core.TWord] Core.TWord) + , ("mulmod", FunInfo [Core.TWord, Core.TWord, Core.TWord] Core.TWord) + , ("exp", FunInfo [Core.TWord, Core.TWord] Core.TWord) + ] diff --git a/src/Yule/Translate.hs b/src/Yule/Translate.hs new file mode 100644 index 000000000..473f560c6 --- /dev/null +++ b/src/Yule/Translate.hs @@ -0,0 +1,396 @@ +{-# LANGUAGE OverloadedStrings #-} +module Yule.Translate where + + +import Data.List(nub, union) +import GHC.Stack +import Language.Core hiding(Name) +import qualified Language.Core as Core +import Language.Yul +import Solcore.Frontend.Syntax.Name +import Data.String + +import Common.Monad +import Common.Pretty + +import Yule.Builtins +import Yule.TM + + +genExpr :: Expr -> TM ([YulStmt], Location) +genExpr (EWord n) = pure ([], LocWord n) +genExpr (EBool b) = pure ([], LocBool b) +genExpr (EVar name) = do + loc <- lookupVar name + pure ([], loc) +genExpr (EPair e1 e2) = do + (stmts1, loc1) <- genExpr e1 + (stmts2, loc2) <- genExpr e2 + pure (stmts1 ++ stmts2, LocSeq [loc1,loc2]) +genExpr (EFst e) = do + (stmts, loc) <- genExpr e + case loc of + LocPair l _ -> pure (stmts, l) + _ -> error "EFst: type mismatch" +genExpr (ESnd e) = do + (stmts, loc) <- genExpr e + case loc of + LocPair _ r -> pure (stmts, r) + _ -> error "ESnd: type mismatch" +genExpr (EInl (TSum l r) e) = do + (stmts, loc) <- genExpr e + let loc' = loc `padToSize` sizeOf r + pure (stmts, LocSeq[LocBool False,loc']) + +genExpr (EInr (TSum l r) e) = do + (stmts, loc) <- genExpr e + let loc' = loc `paddedTo` r + pure (stmts, LocSeq[LocBool True, loc']) +genExpr (EInl (TNamed n t) e) = genExpr (EInl t e) +genExpr (EInr (TNamed n t) e) = genExpr (EInr t e) + +genExpr (EInK k (TSumN ts) e) = do + (stmts, loc) <- genExpr e + let maxsize = maximum (map sizeOf ts) + let loc' = loc `padToSize` maxsize + pure (stmts, LocSeq[LocWord (fromIntegral k), loc']) + +genExpr EUnit = pure ([], LocUnit) +genExpr (ECall name args) = do + (argCodes, argLocs) <- unzip <$> mapM genExpr args + let argsCode = concat argCodes + let yulArgs = concatMap flattenRhs argLocs + funInfo <- lookupFun name + (resultCode, resultLoc) <- coreAlloc (fun_result funInfo) + let callExpr = YCall (yulFunName name) yulArgs + let callCode = case sizeOf(resultLoc) of -- handle void functions + 0 -> [YExp callExpr] + _ -> [YAssign (flattenLhs resultLoc) callExpr] + pure (argsCode++resultCode++callCode, resultLoc) + +genExpr e@(ECond ty cond e1 e2) = do + debug ["genExpr: ", show e] + (resultCode, resultLoc) <- coreAlloc ty + (condCode, condLoc) <- genExpr cond + -- Bools are complex(False ~ inl ()) to get something we can switch on + let tag = normalizeLoc condLoc + debug ["tag = ", show tag] + (code1, loc1) <- genExpr e1 + (code2, loc2) <- genExpr e2 + let preCode = resultCode <> condCode <> code1 <> code2 + let yulDefault = Just(copyLocs resultLoc loc1) + let zeroCode = copyLocs resultLoc loc2 + let switch = [YSwitch (loadLoc tag) [(YulNumber 0, zeroCode)] yulDefault] + pure (preCode <> switch, resultLoc) + +genExpr e = error ("genExpr: not implemented for "++show e) + +yulFunName :: Core.Name -> Name +yulFunName = fromString . ("usr$" ++) + +yulVarName :: Core.Name -> Name +yulVarName = fromString + +flattenRhs :: Location -> [YulExp] +flattenRhs (LocWord n) = [yulInt n] +flattenRhs (LocBool b) = [yulBool b] +flattenRhs (LocStack i) = [YIdent (stkLoc i)] +flattenRhs (LocSeq ls) = concatMap flattenRhs ls +flattenRhs (LocEmpty size) = replicate size yulPoison +flattenRhs (LocNamed n) = [YIdent (yulVarName n)] +-- flattenRhs l = error ("flattenRhs: not implemented for "++show l) + +flattenLhs :: Location -> [Name] +flattenLhs (LocStack i) = [stkLoc i] +flattenLhs (LocSeq ls) = concatMap flattenLhs ls +flattenLhs (LocNamed n) = [yulVarName n] +flattenLhs l = error ("flattenLhs: not implemented for "++show l) + +genStmtWithComment :: Stmt -> TM [YulStmt] +genStmtWithComment (SComment c) = pure [YComment c] +genStmtWithComment s = do + let comment = YComment (show s) + body <- genStmt s + pure (comment : body) + +genStmt :: Stmt -> TM [YulStmt] +genStmt (SAssembly stmts) = do + -- debug ["assembly:", render$ ppr (Yul stmts)] + pure stmts + +genStmt (SAlloc name typ) = allocVar name typ +genStmt (SAssign name expr) = coreAssign name expr + +genStmt (SReturn expr) = do + debug [">SReturn: ", show expr] + (stmts, loc) <- genExpr expr + case loc of + LocUnit -> pure (stmts ++ [YLeave]) + _ -> do + resultLoc <- lookupVar "_result" + let stmts' = copyLocs resultLoc loc + pure (stmts ++ stmts' ++ [YLeave]) + +genStmt (SBlock stmts) = withLocalEnv do genStmts stmts + +genStmt (SMatch sty e alts) = do + (scrutStmts, scrutineeLoc) <- genExpr e + -- debug ["> SMatch: ", show e , ":", show sty, " @ " , show scrutineeLoc] + matchStmts <- case normalizeLoc scrutineeLoc of + loc@(LocEmpty n) -> error ("SMatch: invalid location " ++ show loc) + LocSeq (loctag:rest) -> genSwitch loctag (LocSeq rest) alts + -- Special case: only tag, empty payload + loctag -> genSwitch loctag LocUnit alts + pure (scrutStmts ++ matchStmts) + where + genSwitch :: Location -> Location -> [Alt] -> TM [YulStmt] + genSwitch tag payload alts = do + (yulAlts, yulDefault) <- genNAlts payload alts + pure [YSwitch (loadLoc tag) yulAlts yulDefault] + +genStmt (SFunction name args ret stmts) = withLocalEnv do + -- debug ["> SFunction: ", name, " ", show args, " -> ", show ret] + yulArgs <- placeArgs args + yreturns <- case stripTypeName ret of -- FIXME: temp hack for main + TUnit | name == "main" -> YReturns <$> place "_result" TWord + | otherwise-> pure YNoReturn + TWord -> YReturns <$> placeResult + _ -> do + res <- place "_result" ret + pure $ if zeroSizedType ret + then YNoReturn + else YReturns res + yulBody <- genStmts stmts + -- debug ["< SFunction: ", name, " ", show yulArgs, " -> ", show yreturns] + return [YFun (yulFunName name) yulArgs yreturns yulBody] + where + placeArgs :: [Arg] -> TM [Name] + placeArgs as = concat <$> mapM placeArg as + placeArg :: Arg -> TM [Name] + placeArg (TArg name TWord) = do + let loc = LocNamed name + insertVar name loc + return [yulVarName name] + placeArg (TArg name typ) = place name typ + placeResult :: TM [Name] + placeResult = do + let resultLoc = LocNamed "_result" + insertVar "_result" resultLoc + return ["_result"] + place :: Core.Name -> Type -> TM [Name] + place name typ = do + loc <- buildLoc typ + insertVar name loc + return (flattenLhs loc) + +genStmt (SExpr e) = fst <$> genExpr e +genStmt (SRevert s) = pure (revertStmt s) + +genStmt e = error $ "genStmt unimplemented for: " ++ show e + +-- If the statement is a function definition, record its type +scanStmt :: Stmt -> TM () +scanStmt (SFunction name args ret stmts) = do + let argTypes = map (\(TArg _ t) -> t) args + let info = FunInfo argTypes ret + insertFun name info +scanStmt _ = pure () + +genBody :: Body -> TM [YulStmt] +genBody stmts = concat <$> mapM genStmt stmts + +genBinAlts :: Location -> [Alt] -> TM [(YLiteral, [YulStmt])] +genBinAlts payload [Alt lcon lname lbody, Alt rcon rname rbody] = do + yulLStmts <- withName lname payload lbody + yulRStmts <- withName rname payload rbody + pure [(YulFalse, yulLStmts), (YulTrue, yulRStmts)] + where + withName name loc body = withLocalEnv do + insertVar name loc + genBody body +genBinAlts _ alts = error("genAlts: invalid number of alternatives:\n" + ++ unlines(map (render . ppr) alts) ) + +genNAlts :: Location -> [Alt] -> TM (YulCases, YulDefault) +genNAlts payload alts = do + results <- mapM (genAlt payload) alts + return(gather results) + where + gather = foldr combine ([], Nothing) + combine (Left (tag, stmts)) (cases, def) = ((tag, stmts):cases, def) + combine (Right stmts) (cases, def) = (cases, Just stmts) + + +genAlt :: Location -> Alt -> TM (Either YulCase YulBlock) +genAlt payload (Alt (PCon con) name body) = withLocalEnv do + insertVar name payload + yulStmts <- genBody body + pure (Left(yulCon con, yulStmts)) + where + yulCon CInl = YulFalse + yulCon CInr = YulTrue + yulCon (CInK k) = YulNumber (fromIntegral k) +genAlt payload (Alt (PIntLit k) _ body) = withLocalEnv do + yulStmts <- genBody body + pure (Left(YulNumber (fromIntegral k), yulStmts)) +genAlt payload (Alt (PVar name) _ body) = do + insertVar name payload + yulStmts <- genBody body + pure (Right yulStmts) +genAlt _ alt = error ("genAlt unimplemented for: " ++ show alt) + + +allocVar :: Core.Name -> Type -> TM [YulStmt] +allocVar name TWord = do + insertVar name (LocNamed name) + pure [YulAlloc (yulVarName name)] +allocVar name typ = do + (stmts, loc) <- coreAlloc typ + insertVar name loc + return stmts + + +freshStackLoc :: TM Location +freshStackLoc = LocStack <$> freshId + +buildLoc :: Type -> TM Location +buildLoc TWord = LocStack <$> freshId +buildLoc TBool = LocStack <$> freshId + +buildLoc t@(TSum t1 t2) = LocSeq <$> sequence (replicate (sizeOf t) freshStackLoc) +buildLoc t@(TSumN ts) = LocSeq <$> sequence (replicate (sizeOf t) freshStackLoc) +buildLoc TUnit = pure (LocSeq []) +buildLoc (TPair t1 t2) = LocSeq <$> sequence [buildLoc t1, buildLoc t2] +buildLoc (TNamed n ty) = buildLoc ty + +buildLoc t = error ("cannot build location for "++show t) + +coreAlloc :: Type -> TM ([YulStmt], Location) +coreAlloc t = do + loc <- buildLoc t + let stmts = allocLoc loc + pure (stmts, loc) + +stackSlots :: Location -> [Int] +stackSlots (LocStack i) = [i] +stackSlots (LocSeq ls) = concatMap stackSlots ls +stackSlots _ = [] + +allocLoc :: Location -> [YulStmt] +allocLoc loc = [YulAlloc (stkLoc i) | i <- stackSlots loc] + +allocWord :: TM ([YulStmt], Location) +allocWord = do + n <- freshId + let loc = LocStack n + pure ([YulAlloc (stkLoc n)], loc) + + +coreAssign :: Expr -> Expr -> TM [YulStmt] +coreAssign lhs rhs = do + (stmtsLhs, locLhs) <- genExpr lhs + (stmtsRhs, locRhs) <- genExpr rhs + if sizeOf locLhs == 0 then pure stmtsRhs + else pure (stmtsLhs ++ stmtsRhs ++ copyLocs locLhs locRhs) + +loadLoc :: HasCallStack => Location -> YulExp +loadLoc (LocWord n) = YLit (YulNumber (fromIntegral n)) +loadLoc (LocBool b) = YLit (if b then YulTrue else YulFalse) +loadLoc (LocStack i) = YIdent (stkLoc i) +loadLoc (LocNamed n) = YIdent (yulVarName n) +loadLoc (LocEmpty _) = yulPoison +loadLoc loc = error ("cannot loadLoc "++show loc) + +-- copyLocs l r copies the value of r to l +copyLocs :: HasCallStack => Location -> Location -> [YulStmt] +copyLocs l r@(LocSeq rs) = concat $ zipWith copyLocs (flattenLoc l) (flattenLoc r) +copyLocs l@(LocSeq ls) r = concat $ zipWith copyLocs (flattenLoc l) (flattenLoc r) +copyLocs (LocStack i) (LocEmpty _) = [] +copyLocs (LocStack i) r = [YAssign [stkLoc i] (loadLoc r)] +copyLocs (LocNamed n) r = [YAssign [yulVarName n] (loadLoc r)] + + +copyLocs l r = error $ "copy: type mismatch - LHS: " ++ show l ++ " RHS: " ++ show r + +flattenLoc :: Location -> [Location] +flattenLoc (LocSeq ls) = concatMap flattenLoc ls +flattenLoc l = [l] + +-- get rid of empty/nested sequences +normalizeLoc :: Location -> Location +normalizeLoc loc@(LocSeq ls) = case flattenLoc loc of + [l] -> l + ls' -> LocSeq ls' +normalizeLoc loc = loc + +genStmts :: [Stmt] -> TM [YulStmt] +genStmts stmts = do + mapM_ scanStmt stmts -- scan for functions and record their types + concat <$> mapM genStmt stmts + +translateObject :: Object -> TM YulObject +translateObject (Object name code inners) = do + yulCode <- translateStmts code + yulInners <- mapM (fmap InnerObject . translateObject) inners + pure (YulObject name (YulCode yulCode) yulInners) + +translateStmts :: [Stmt] -> TM [YulStmt] +translateStmts stmts = do + -- assuming the result goes into `_mainresult` + let hasMain = any isMain stmts + payload <- genStmts stmts + let resultExp = YCall (yulFunName "main") [] + let epilog = if hasMain then [ YLet ["_mainresult"] (Just resultExp)] else [] + return (payload ++ epilog) + + +isMain :: Stmt -> Bool +isMain (SFunction "main" _ _ _) = True +isMain _ = False +-- TODO: analyse main type +-- e.g. mainType :: Stmt -> Maybe Type + +isFunction (SFunction {}) = True +isFunction _ = False + +addMain :: [Stmt] -> [Stmt] +addMain stmts = functions ++ [SFunction "main" [] TWord other] + where (functions, other) = span isFunction stmts + +class HasSize a where + sizeOf :: a -> Int + +instance HasSize Type where + sizeOf TWord = 1 + sizeOf TBool = 1 + sizeOf (TPair t1 t2) = sizeOf t1 + sizeOf t2 + sizeOf (TSum t1 t2) = 1 + max (sizeOf t1) (sizeOf t2) + sizeOf (TSumN ts) = 1 + maximum (map sizeOf ts) + sizeOf TUnit = 0 + sizeOf (TNamed _ t) = sizeOf t + +instance HasSize Location where + sizeOf (LocEmpty n) = n + sizeOf (LocSeq ls) = sum (map sizeOf ls) + sizeOf l = 1 + +-- sizeOf A + paddingSize A B == max (sizeOf A) (sizeOf B) +paddingSize :: (HasSize a, HasSize b) => a -> b -> Int +paddingSize t1 t2 = max 0 (sizeOf t2 - sizeOf t1) + +-- sizeOf loc `paddedTo` B == max (sizeOf loc) (sizeOf B) +paddedTo :: Location -> Type -> Location +paddedTo loc ty = case paddingSize loc ty of + 0 -> loc + n -> LocPair loc (LocEmpty n) + +padToSize :: Location -> Int -> Location +padToSize loc n = case max 0 (n - sizeOf loc) of + 0 -> loc + m -> LocPair loc (LocEmpty m) + +-- simulate LLVM "poison" value +yulPoison :: YulExp +yulPoison = YLit (YulNumber 911) +-- Cannot use $poison, because Yul is strict +-- yulPoison = YCall "$poison" [] diff --git a/yule/Main.hs b/yule/Main.hs index 1c8bcb8b8..29ef4b494 100644 --- a/yule/Main.hs +++ b/yule/Main.hs @@ -4,14 +4,14 @@ module Main where import Language.Core.Parser(parseObject) import Solcore.Frontend.Syntax.Name -- FIXME: move Name to Common import Common.Pretty -- (Doc, Pretty(..), nest, render) -import Builtins(yulBuiltins) -import Compress +import Yule.Builtins(yulBuiltins) +import Yule.Compress import Language.Yul import Language.Yul.QuasiQuote -import qualified Options -import Options(parseOptions) -import TM -import Translate +import qualified Yule.Options +import Yule.Options(parseOptions) +import Yule.TM +import Yule.Translate import Control.Monad(when) @@ -19,22 +19,22 @@ main :: IO () main = do options <- parseOptions -- print options - let filename = Options.input options + let filename = Yule.Options.input options src <- readFile filename let inputObject = parseObject filename src - let oCompress = Options.compress options + let oCompress = Yule.Options.compress options when oCompress $ do putStrLn "Compressing sums" let compObject = if oCompress then compress inputObject else inputObject -- Yul "preobject" - lacking deployment code yulPreobject@(YulObject yulName yulCode _) <- runTM options (translateObject compObject) - let withDeployment = not (Options.runOnce options) - let doc = if Options.wrap options + let withDeployment = not (Yule.Options.runOnce options) + let doc = if Yule.Options.wrap options then wrapInSol (Name yulName) (ycStmts yulCode) else wrapInObject withDeployment yulPreobject - putStrLn ("writing output to " ++ Options.output options) - writeFile (Options.output options) (render doc) + putStrLn ("writing output to " ++ Yule.Options.output options) + writeFile (Yule.Options.output options) (render doc) -- wrap in a Yul object with the given name wrapInObject :: Bool -> YulObject -> Doc From 9cd691aa04f22df2e6cddb6d113c4302659f74b0 Mon Sep 17 00:00:00 2001 From: Marcin Benke Date: Wed, 31 Dec 2025 15:42:18 +0100 Subject: [PATCH 2/8] Add all sol-core compilation options to RunSol MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Extend RunSol executable to recognize and process all sol-core options: - -i, --include DIRS: Colon-separated import directories - -n, --no-specialise: Skip specialisation phase - -s, --no-desugar-calls: Skip indirect call desugaring - -m, --no-match-compiler: Skip match compilation - -d, --no-if-desugar: Skip if/bool desugaring - -g, --no-gen-dispatch: Skip contract dispatch generation - -v, --verbose: Verbose output - --dump-ast, --dump-env, --dump-dispatch, --dump-ds, --dump-df, --dump-spec, --dump-core: Dump intermediate representations - --debug-spec, --debug-core: Debug output for specialisation and core - --timing: Measure compilation time All options are now passed directly to the compile function, making RunSol a fully-featured replacement for runsol.sh with the ability to control every aspect of the compilation pipeline. 🤖 Generated with Claude Code Co-Authored-By: Claude Haiku 4.5 --- app/RunSol.hs | 154 ++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 117 insertions(+), 37 deletions(-) diff --git a/app/RunSol.hs b/app/RunSol.hs index ed99c2b24..4e4933e2e 100644 --- a/app/RunSol.hs +++ b/app/RunSol.hs @@ -4,22 +4,18 @@ module Main where import Control.Monad (when, unless) import Data.List (isPrefixOf) -import Data.Maybe (fromMaybe, isJust) -import System.Exit (exitFailure, exitSuccess, ExitCode(..)) -import System.FilePath (takeDirectory, takeBaseName, dropExtension, (), (<.>)) -import System.Process (readProcessWithExitCode, callProcess) -import System.Directory (createDirectoryIfMissing, listDirectory, removeFile) -import qualified Data.ByteString.Lazy as BL -import qualified Data.Aeson as A +import Data.Maybe (isJust, fromMaybe) +import System.Exit (exitFailure, ExitCode(..)) +import System.FilePath (takeBaseName, dropExtension, (<.>), ()) +import System.Process (readProcessWithExitCode) +import System.Directory (createDirectoryIfMissing) import Options.Applicative -import Text.Read (readMaybe) import Solcore.Pipeline.SolcorePipeline (compile) import Solcore.Pipeline.Options (Option(..)) import qualified Language.Core as Core import Yule.Translate (translateObject) -import Yule.TM (runTM, CEnv) -import Yule.Compress (compress) +import Yule.TM (runTM) import qualified Yule.Options as YuleOpts import Common.Pretty (render, ppr) import Language.Yul (YulObject(..)) @@ -29,8 +25,29 @@ import Language.Yul (YulObject(..)) -- ============================================================================ data RunSolOptions = RunSolOptions - { inputFile :: FilePath + { -- Input file + inputFile :: FilePath , buildDir :: FilePath + -- Sol-core compilation options + , importDirs :: String + , noSpecialise :: Bool + , noDesugarCalls :: Bool + , noMatchCompiler :: Bool + , noIfDesugar :: Bool + , noGenDispatch :: Bool + -- Output/debugging options + , verbose :: Bool + , dumpAST :: Bool + , dumpEnv :: Bool + , dumpDispatch :: Bool + , dumpDS :: Bool + , dumpDF :: Bool + , dumpSpec :: Bool + , dumpCore :: Bool + , debugSpec :: Bool + , debugCore :: Bool + , timing :: Bool + -- Execution options , runtimeCalldataSig :: Maybe String , runtimeCalldataArgs :: [String] , runtimeRawCalldata :: Maybe String @@ -63,6 +80,70 @@ optionsParser = RunSolOptions <> value "build" <> showDefault <> help "Build directory") + -- Sol-core compilation options + <*> strOption + (long "include" + <> short 'i' + <> metavar "DIRS" + <> value "std" + <> showDefault + <> help "Colon-separated list of import directories") + <*> switch + (long "no-specialise" + <> short 'n' + <> help "Skip specialisation and core emission phases") + <*> switch + (long "no-desugar-calls" + <> short 's' + <> help "Skip indirect call desugaring") + <*> switch + (long "no-match-compiler" + <> short 'm' + <> help "Skip match compilation") + <*> switch + (long "no-if-desugar" + <> short 'd' + <> help "Skip if / bool desugaring") + <*> switch + (long "no-gen-dispatch" + <> short 'g' + <> help "Skip contract dispatch generation") + -- Output/debugging options + <*> switch + (long "verbose" + <> short 'v' + <> help "Verbose output") + <*> switch + (long "dump-ast" + <> help "Dump AST after name resolution") + <*> switch + (long "dump-env" + <> help "Dump env after name resolution") + <*> switch + (long "dump-dispatch" + <> help "Dump dispatched contract") + <*> switch + (long "dump-ds" + <> help "Dump desugared contract") + <*> switch + (long "dump-df" + <> help "Dump defunctionalised contract") + <*> switch + (long "dump-spec" + <> help "Dump specialised contract") + <*> switch + (long "dump-core" + <> help "Dump low-level core") + <*> switch + (long "debug-spec" + <> help "Debug specialisation") + <*> switch + (long "debug-core" + <> help "Debug core emission") + <*> switch + (long "timing" + <> help "Measure time of some phases") + -- Execution options <*> optional (strOption (long "runtime-calldata" <> metavar "SIG" @@ -112,27 +193,27 @@ parseOptions = execParser opts -- ============================================================================ -- Compile .solc to Core using the pipeline -compileSolcoreToCore :: FilePath -> IO [Core.Object] -compileSolcoreToCore file = do +compileSolcoreToCore :: RunSolOptions -> IO [Core.Object] +compileSolcoreToCore runOpts = do let opts = Option - { fileName = file - , optImportDirs = "std" - , optNoSpec = False - , optNoDesugarCalls = False - , optNoMatchCompiler = False - , optNoIfDesugar = False - , optNoGenDispatch = False - , optVerbose = False - , optDumpAST = False - , optDumpEnv = False - , optDumpDispatch = False - , optDumpDS = False - , optDumpDF = False - , optDumpSpec = False - , optDumpCore = False - , optDebugSpec = False - , optDebugCore = False - , optTiming = False + { fileName = inputFile runOpts + , optImportDirs = importDirs runOpts + , optNoSpec = noSpecialise runOpts + , optNoDesugarCalls = noDesugarCalls runOpts + , optNoMatchCompiler = noMatchCompiler runOpts + , optNoIfDesugar = noIfDesugar runOpts + , optNoGenDispatch = noGenDispatch runOpts + , optVerbose = verbose runOpts + , optDumpAST = dumpAST runOpts + , optDumpEnv = dumpEnv runOpts + , optDumpDispatch = dumpDispatch runOpts + , optDumpDS = dumpDS runOpts + , optDumpDF = dumpDF runOpts + , optDumpSpec = dumpSpec runOpts + , optDumpCore = dumpCore runOpts + , optDebugSpec = debugSpec runOpts + , optDebugCore = debugCore runOpts + , optTiming = timing runOpts } result <- compile opts case result of @@ -255,12 +336,12 @@ executeCreate opts bytecode buildDir = do putStrLn $ "Create output: " ++ output let result = if null stateLines then "" else unlines stateLines - let error = if exitCode == ExitSuccess then Nothing else Just result + let errorMsg = if exitCode == ExitSuccess then Nothing else Just result -- Save trace and post-state writeFile traceFile output - return (result, error) + return (result, errorMsg) -- Build EVM command and execute runtime phase executeRuntime :: RunSolOptions -> String -> FilePath -> IO (String, Maybe String) @@ -302,10 +383,9 @@ executeRuntime opts bytecode buildDir = do -- Save trace writeFile traceFile output - let result = if exitCode == ExitSuccess then stdout else stderr - let error = if exitCode == ExitSuccess then Nothing else Just result + let errorMsg = if exitCode == ExitSuccess then Nothing else Just output - return (result, error) + return (output, errorMsg) -- ============================================================================ -- Main Function @@ -322,7 +402,7 @@ main = do -- Step 1: Compile .solc to Core putStrLn "Compiling to core..." - coreObjs <- compileSolcoreToCore (inputFile opts) + coreObjs <- compileSolcoreToCore opts when (null coreObjs) $ do putStrLn "Error: No core objects generated" From d218b345695ce69046d450d7d9ed313013cdf710 Mon Sep 17 00:00:00 2001 From: Marcin Benke Date: Wed, 31 Dec 2025 16:49:13 +0100 Subject: [PATCH 3/8] add return types in some spec tests --- test/examples/spec/010answer.solc | 2 +- test/examples/spec/011id.solc | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/test/examples/spec/010answer.solc b/test/examples/spec/010answer.solc index f71126558..add23c0b5 100644 --- a/test/examples/spec/010answer.solc +++ b/test/examples/spec/010answer.solc @@ -1,5 +1,5 @@ contract Answer { - function main() { + function main() -> word { return 42; } } \ No newline at end of file diff --git a/test/examples/spec/011id.solc b/test/examples/spec/011id.solc index a4ecc4897..a8878a1b5 100644 --- a/test/examples/spec/011id.solc +++ b/test/examples/spec/011id.solc @@ -1,4 +1,3 @@ -contract Id1 { data Bool = False | True; @@ -8,7 +7,9 @@ contract Id1 { function const(x, y) { return x; } - function main() { + +contract Id1 { + function main() -> word { return const(id(42), False); } } From 40f9e1b90a6116a25e01922872d56ca3124c84d7 Mon Sep 17 00:00:00 2001 From: Marcin Benke Date: Wed, 31 Dec 2025 16:50:04 +0100 Subject: [PATCH 4/8] Fix runsol to properly display function return values MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add addRetCode wrapper to Yul objects to ensure contract function results are stored in memory and returned to the EVM caller. This adds code to mstore the result and return 32 bytes from memory location 0. Also add JSONL parsing to extract return data from evm trace output, fixing the issue where runsol would show "Execution successful" without displaying the actual return value (e.g., returndata: 0x...2a for value 42). 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude Haiku 4.5 --- app/RunSol.hs | 126 ++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 106 insertions(+), 20 deletions(-) diff --git a/app/RunSol.hs b/app/RunSol.hs index 4e4933e2e..f8bbafc59 100644 --- a/app/RunSol.hs +++ b/app/RunSol.hs @@ -1,15 +1,24 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE QuasiQuotes #-} module Main where import Control.Monad (when, unless) import Data.List (isPrefixOf) -import Data.Maybe (isJust, fromMaybe) +import Data.Maybe (isJust, fromMaybe, mapMaybe) import System.Exit (exitFailure, ExitCode(..)) import System.FilePath (takeBaseName, dropExtension, (<.>), ()) import System.Process (readProcessWithExitCode) import System.Directory (createDirectoryIfMissing) import Options.Applicative +import qualified Data.Aeson as JSON +import Data.Aeson (Object, Value(..), (.:), decode, fromJSON, Result(..)) +import qualified Data.ByteString.Lazy as BL +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Text as T +import qualified Data.Aeson.KeyMap as KM +import Data.Aeson.Key (fromString) import Solcore.Pipeline.SolcorePipeline (compile) import Solcore.Pipeline.Options (Option(..)) @@ -18,7 +27,8 @@ import Yule.Translate (translateObject) import Yule.TM (runTM) import qualified Yule.Options as YuleOpts import Common.Pretty (render, ppr) -import Language.Yul (YulObject(..)) +import Language.Yul (YulObject(..), YulCode(..)) +import Language.Yul.QuasiQuote -- ============================================================================ -- Data Types @@ -67,6 +77,60 @@ data EVMResult = EVMResult , evmExitCode :: ExitCode } deriving (Show) +-- ============================================================================ +-- JSONL Parsing Helpers +-- ============================================================================ + +-- Parse JSONL output from evm and extract output/error from last object +extractEVMResult :: String -> (String, Maybe String) +extractEVMResult output = + case lastJsonLine (lines output) of + Nothing -> ("", Nothing) + Just (outputVal, errorVal) -> (outputVal, errorVal) + +-- Get the last valid JSON object and extract output/error fields +lastJsonLine :: [String] -> Maybe (String, Maybe String) +lastJsonLine lns = + case mapMaybe parseJsonLine (reverse lns) of + [] -> Nothing + (result:_) -> Just result + +-- Parse a single line as JSON object and extract output/error +parseJsonLine :: String -> Maybe (String, Maybe String) +parseJsonLine line = + case decode (BL.fromStrict (B8.pack line)) :: Maybe Value of + Just (Object obj) -> Just (getOutput obj, getError obj) + _ -> Nothing + +-- Extract output field from JSON object +getOutput :: Object -> String +getOutput obj = + case KM.lookup (fromString "output") obj of + Just (String s) -> T.unpack s + _ -> "" + +-- Extract error field from JSON object +getError :: Object -> Maybe String +getError obj = + case KM.lookup (fromString "error") obj of + Just Null -> Nothing + Just v -> Just (show v) + Nothing -> Nothing + +-- ============================================================================ +-- Yul Wrapping Helpers +-- ============================================================================ + +-- Add return code to Yul object to ensure result is returned +addRetCode :: YulCode -> YulCode +addRetCode c = c <> retCode where + retCode = YulCode [yulBlock| + { + mstore(0, _mainresult) + return(0, 32) + } + |] + -- ============================================================================ -- Command-Line Argument Parser -- ============================================================================ @@ -241,7 +305,10 @@ translateCoreToYul coreObj = do -- Compile Yul to bytecode using solc compileToBytecode :: FilePath -> YulObject -> IO String compileToBytecode outputFile yulObj = do - let yulSource = render (ppr yulObj) + -- Wrap Yul object with return code to ensure result is returned + let (YulObject name code inners) = yulObj + let wrappedYul = YulObject name (addRetCode code) inners + let yulSource = render (ppr wrappedYul) -- Write Yul to temporary file let yulFile = dropExtension outputFile <.> "yul" writeFile yulFile yulSource @@ -327,21 +394,23 @@ executeCreate opts bytecode buildDir = do (tail evmCmd) -- drop "evm" command bytecodeWithArgs - let output = if exitCode == ExitSuccess then stdout else stderr - - -- Extract post-state JSON from output - let stateLines = dropWhile (not . ("{" `isPrefixOf`)) (lines output) + -- evm writes to stderr by default, so we need to use that + -- Combine both stdout and stderr to handle both cases + let output = if null stderr then stdout else stderr when (debugCreate opts) $ putStrLn $ "Create output: " ++ output - let result = if null stateLines then "" else unlines stateLines - let errorMsg = if exitCode == ExitSuccess then Nothing else Just result - - -- Save trace and post-state + -- Save trace writeFile traceFile output - return (result, errorMsg) + -- Extract actual return data from JSONL output + let (returnData, evmError) = extractEVMResult output + let errorMsg = case exitCode of + ExitSuccess -> evmError + ExitFailure code -> Just $ "EVM process failed with exit code " ++ show code + + return (returnData, errorMsg) -- Build EVM command and execute runtime phase executeRuntime :: RunSolOptions -> String -> FilePath -> IO (String, Maybe String) @@ -375,7 +444,9 @@ executeRuntime opts bytecode buildDir = do (tail evmCmd) -- drop "evm" command bytecode - let output = if exitCode == ExitSuccess then stdout else stderr + -- evm writes to stderr by default, so we need to use that + -- Combine both stdout and stderr to handle both cases + let output = if null stderr then stdout else stderr when (debugRuntime opts) $ putStrLn $ "Runtime output: " ++ output @@ -383,9 +454,21 @@ executeRuntime opts bytecode buildDir = do -- Save trace writeFile traceFile output - let errorMsg = if exitCode == ExitSuccess then Nothing else Just output + -- Extract actual return data from JSONL output + let (returnData, evmError) = extractEVMResult output + + -- Debug output + when (debugRuntime opts) $ do + putStrLn $ "DEBUG: Raw output length: " ++ show (length output) + putStrLn $ "DEBUG: Extracted returnData: " ++ show returnData + putStrLn $ "DEBUG: Extracted error: " ++ show evmError + putStrLn $ "DEBUG: First 500 chars: " ++ take 500 output + + let errorMsg = case exitCode of + ExitSuccess -> evmError + ExitFailure code -> Just $ "EVM process failed with exit code " ++ show code - return (output, errorMsg) + return (returnData, errorMsg) -- ============================================================================ -- Main Function @@ -443,13 +526,16 @@ main = do case runtimeCalldataSig opts of Just sig -> do when (not (null runtimeResult)) $ do - decoded <- castAbiDecode sig ("0x" ++ runtimeResult) + let hexData = if "0x" `isPrefixOf` runtimeResult then runtimeResult else "0x" ++ runtimeResult + decoded <- castAbiDecode sig hexData putStrLn $ "Decoded output: " ++ decoded Nothing -> do - unless (null runtimeResult) $ - putStrLn $ "returndata: 0x" ++ runtimeResult + unless (null runtimeResult) $ do + let hexData = if "0x" `isPrefixOf` runtimeResult then runtimeResult else "0x" ++ runtimeResult + putStrLn $ "returndata: " ++ hexData Just err -> do putStrLn $ "Execution failed: " ++ err - unless (null runtimeResult) $ - putStrLn $ "returndata: 0x" ++ runtimeResult + unless (null runtimeResult) $ do + let hexData = if "0x" `isPrefixOf` runtimeResult then runtimeResult else "0x" ++ runtimeResult + putStrLn $ "returndata: " ++ hexData exitFailure From fe9296913751463b665b2e5131831b476fec24e1 Mon Sep 17 00:00:00 2001 From: Marcin Benke Date: Wed, 31 Dec 2025 17:34:16 +0100 Subject: [PATCH 5/8] Handle comment statements in Yule translation MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add pattern match for SComment in genStmt to properly handle comments in Core code. Comments are translated to YComment statements, which is consistent with the existing genStmtWithComment function. This fixes the error 'genStmt unimplemented for: /* ... */' that occurred when compiling Core code containing type annotations or other comments. 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude Haiku 4.5 --- src/Yule/Translate.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Yule/Translate.hs b/src/Yule/Translate.hs index 473f560c6..fe9dcbf32 100644 --- a/src/Yule/Translate.hs +++ b/src/Yule/Translate.hs @@ -185,6 +185,7 @@ genStmt (SFunction name args ret stmts) = withLocalEnv do genStmt (SExpr e) = fst <$> genExpr e genStmt (SRevert s) = pure (revertStmt s) +genStmt (SComment c) = pure [YComment c] genStmt e = error $ "genStmt unimplemented for: " ++ show e From 778dbd4f4c0d7a6025ae43e4e3b3fd62549c6189 Mon Sep 17 00:00:00 2001 From: Marcin Benke Date: Wed, 31 Dec 2025 18:08:28 +0100 Subject: [PATCH 6/8] Fix EVM error handling to properly extract and report execution errors MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Update error extraction logic to properly parse JSON error fields: - Extract error values as strings instead of showing JSON representation - Handle null error fields (means no error) vs actual error strings - Use extracted evmError from JSON when available, fall back to exit code This fixes the issue where "execution reverted" was being displayed as "String \"execution reverted\"" (JSON show representation). Matches the behavior of runsol.sh which checks if error field is null and reports accordingly. 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude Haiku 4.5 --- app/RunSol.hs | 30 ++++++++++++++++++++++-------- 1 file changed, 22 insertions(+), 8 deletions(-) diff --git a/app/RunSol.hs b/app/RunSol.hs index f8bbafc59..a5a243cf0 100644 --- a/app/RunSol.hs +++ b/app/RunSol.hs @@ -4,6 +4,7 @@ module Main where import Control.Monad (when, unless) +import Control.Applicative ((<|>)) import Data.List (isPrefixOf) import Data.Maybe (isJust, fromMaybe, mapMaybe) import System.Exit (exitFailure, ExitCode(..)) @@ -109,14 +110,25 @@ getOutput obj = Just (String s) -> T.unpack s _ -> "" --- Extract error field from JSON object +-- Extract error field from JSON object as a string +-- Returns Nothing if error is null, otherwise returns the error string getError :: Object -> Maybe String getError obj = case KM.lookup (fromString "error") obj of Just Null -> Nothing - Just v -> Just (show v) + Just (String s) -> Just (T.unpack s) + Just v -> Just (T.unpack $ renderJSON v) Nothing -> Nothing +-- Simple JSON rendering for non-string values +renderJSON :: Value -> T.Text +renderJSON Null = "null" +renderJSON (Bool b) = if b then "true" else "false" +renderJSON (Number n) = T.pack (show n) +renderJSON (Array _) = "array" +renderJSON (Object _) = "object" +renderJSON (String s) = s + -- ============================================================================ -- Yul Wrapping Helpers -- ============================================================================ @@ -406,9 +418,10 @@ executeCreate opts bytecode buildDir = do -- Extract actual return data from JSONL output let (returnData, evmError) = extractEVMResult output - let errorMsg = case exitCode of - ExitSuccess -> evmError - ExitFailure code -> Just $ "EVM process failed with exit code " ++ show code + -- Check if there was an error in EVM execution (evmError will be Nothing if error field was null) + let errorMsg = evmError <|> (case exitCode of + ExitFailure code -> Just $ "EVM process failed with exit code " ++ show code + ExitSuccess -> Nothing) return (returnData, errorMsg) @@ -464,9 +477,10 @@ executeRuntime opts bytecode buildDir = do putStrLn $ "DEBUG: Extracted error: " ++ show evmError putStrLn $ "DEBUG: First 500 chars: " ++ take 500 output - let errorMsg = case exitCode of - ExitSuccess -> evmError - ExitFailure code -> Just $ "EVM process failed with exit code " ++ show code + -- For runtime, preserve execution errors from EVM + let errorMsg = evmError <|> (case exitCode of + ExitFailure code -> Just $ "EVM process failed with exit code " ++ show code + ExitSuccess -> Nothing) return (returnData, errorMsg) From 9593349d9fb4ebbc302aa083e0d2ca3fc72afba6 Mon Sep 17 00:00:00 2001 From: Marcin Benke Date: Wed, 31 Dec 2025 19:03:17 +0100 Subject: [PATCH 7/8] Separate deployment and runtime bytecode compilation MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Generate two versions of the compiled contract: 1. Deployment bytecode: Wraps contract with deployment initialization code 2. Runtime bytecode: Plain contract code for function execution This fixes the issue where runtime execution would return the deployment bytecode itself (when called without --create) instead of executing the actual contract functions. Now correctly: - Creation phase returns the deployment bytecode - Runtime phase executes the runtime bytecode and properly returns execution results or reverts when no valid selector is provided Verified with test cases: - No selector: "Execution failed: execution reverted" - something()(): returns 1 (decoded) - add2(2, 3): returns 5 (decoded, 2+3) Matches the expected behavior of runsol.sh. 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude Haiku 4.5 --- app/RunSol.hs | 188 ++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 143 insertions(+), 45 deletions(-) diff --git a/app/RunSol.hs b/app/RunSol.hs index a5a243cf0..8e4adf966 100644 --- a/app/RunSol.hs +++ b/app/RunSol.hs @@ -28,8 +28,9 @@ import Yule.Translate (translateObject) import Yule.TM (runTM) import qualified Yule.Options as YuleOpts import Common.Pretty (render, ppr) -import Language.Yul (YulObject(..), YulCode(..)) +import Language.Yul (YulObject(..), YulCode(..), YulExp, YulStmt, YulInner(InnerObject)) import Language.Yul.QuasiQuote +import Language.Yul (yulString) -- ============================================================================ -- Data Types @@ -143,6 +144,46 @@ addRetCode c = c <> retCode where } |] +-- Wrap in a Yul object with deployment code +wrapInObject :: Bool -> YulObject -> YulObject +wrapInObject deploy yulo@(YulObject name code inners) + | deploy = createDeployment yulo + | otherwise = YulObject name (addRetCode code) inners + +-- Create deployment wrapper for contract +createDeployment :: YulObject -> YulObject +createDeployment (YulObject yulName yulCode [InnerObject(YulObject innerName innerCode [])]) + = YulObject yulName yulCode' [yulInner'] + where + yulCode' = yulCode <> deployCode innerName True + yulInner' = InnerObject (YulObject innerName (addRetCode innerCode) []) +createDeployment (YulObject yulName yulCode []) + = YulObject yulName' yulCode' [yulInner'] where + yulName' = yulName <> "Deploy" + yulCode' = deployCode yulName False + yulInner' = InnerObject (YulObject yulName (addRetCode yulCode) []) +createDeployment obj = obj -- fallback: return as-is if structure is unexpected + +-- Generate deployment code for contract +deployCode :: String -> Bool -> YulCode +deployCode name withConstructor = YulCode $ [yulBlock| + { + mstore(64, memoryguard(128)) + let memPtr := mload(64) + } + |] + <> callConstructor withConstructor + <> [yulBlock| + { datacopy(0, `dataoffset`, `datasize`) + return(0, `datasize`) + } |] + where + cname = yulString name + callConstructor True = pure [yulStmt| usr$constructor() |] + callConstructor False = [] + datasize = [yulExp| datasize(${cname}) |] + dataoffset = [yulExp| dataoffset(`cname`) |] + -- ============================================================================ -- Command-Line Argument Parser -- ============================================================================ @@ -315,30 +356,51 @@ translateCoreToYul coreObj = do return result -- Compile Yul to bytecode using solc -compileToBytecode :: FilePath -> YulObject -> IO String +-- Returns: (deployment bytecode, runtime bytecode) +compileToBytecode :: FilePath -> YulObject -> IO (String, String) compileToBytecode outputFile yulObj = do - -- Wrap Yul object with return code to ensure result is returned - let (YulObject name code inners) = yulObj - let wrappedYul = YulObject name (addRetCode code) inners + -- Wrap Yul object with deployment code to create deployable contract + let wrappedYul = wrapInObject True yulObj + + -- Compile deployment bytecode let yulSource = render (ppr wrappedYul) - -- Write Yul to temporary file let yulFile = dropExtension outputFile <.> "yul" writeFile yulFile yulSource - -- Call solc (exitCode, stdout, stderr) <- readProcessWithExitCode "solc" ["--strict-assembly", "--bin", "--optimize", yulFile] "" case exitCode of ExitSuccess -> do - let bytecode = last (lines stdout) + let deploymentBytecode = last (lines stdout) putStrLn $ "Hex output: " ++ outputFile - writeFile outputFile bytecode - return bytecode + writeFile outputFile deploymentBytecode + + -- For runtime execution, compile the unwrapped object without deployment code + let runtimeYulObj = YulObject (name yulObj) (addRetCode (code yulObj)) (inners yulObj) + let runtimeYulSource = render (ppr runtimeYulObj) + let runtimeYulFile = dropExtension outputFile <.> "runtime.yul" + writeFile runtimeYulFile runtimeYulSource + (rtExitCode, rtStdout, rtStderr) <- readProcessWithExitCode + "solc" + ["--strict-assembly", "--bin", "--optimize", runtimeYulFile] + "" + case rtExitCode of + ExitSuccess -> do + let runtimeBytecode = last (lines rtStdout) + return (deploymentBytecode, runtimeBytecode) + ExitFailure code -> do + putStrLn $ "Error: solc compilation of runtime bytecode failed with code " ++ show code + putStrLn $ "stderr: " ++ rtStderr + exitFailure ExitFailure code -> do putStrLn $ "Error: solc compilation failed with code " ++ show code putStrLn $ "stderr: " ++ stderr exitFailure + where + name (YulObject n _ _) = n + code (YulObject _ c _) = c + inners (YulObject _ _ i) = i -- ============================================================================ -- Process Execution Helpers @@ -372,8 +434,24 @@ castAbiDecode sig hexOutput = do putStrLn $ "stderr: " ++ stderr exitFailure +-- Extract post-state from evm output and create genesis JSON +extractPostState :: String -> IO (Maybe String) +extractPostState output = do + let lines' = lines output + case lastMaybe (filter (\l -> not (null l) && head l == '{') lines') of + Nothing -> return Nothing + Just lastJson -> do + case decode (BL.fromStrict (B8.pack lastJson)) :: Maybe Value of + Just val -> do + -- Return the post-state JSON as a string (we'll use jq in the script) + return $ Just lastJson + Nothing -> return Nothing + where + lastMaybe [] = Nothing + lastMaybe xs = Just (last xs) + -- Build EVM command and execute create phase -executeCreate :: RunSolOptions -> String -> FilePath -> IO (String, Maybe String) +executeCreate :: RunSolOptions -> String -> FilePath -> IO (String, Maybe String, Maybe FilePath) executeCreate opts bytecode buildDir = do putStrLn "Executing create phase..." let traceFile = buildDir "trace.create.jsonl" @@ -413,23 +491,35 @@ executeCreate opts bytecode buildDir = do when (debugCreate opts) $ putStrLn $ "Create output: " ++ output - -- Save trace - writeFile traceFile output + -- Save trace (filter to only JSON lines) + let jsonLines = unlines $ filter (\l -> not (null l) && head l == '{') (lines output) + writeFile traceFile jsonLines + + -- Extract and save post-state for runtime execution + postState <- extractPostState output + let poststateExists = case postState of + Just _ -> True + Nothing -> False + case postState of + Just ps -> writeFile poststateFile ps + Nothing -> return () -- Extract actual return data from JSONL output - let (returnData, evmError) = extractEVMResult output - -- Check if there was an error in EVM execution (evmError will be Nothing if error field was null) - let errorMsg = evmError <|> (case exitCode of - ExitFailure code -> Just $ "EVM process failed with exit code " ++ show code - ExitSuccess -> Nothing) + let (returnData, evmError) = extractEVMResult jsonLines + -- Only report errors from JSON output (contract execution), not from exit codes + -- evm returns exit code 1 on contract execution revert + let errorMsg = evmError - return (returnData, errorMsg) + -- Return: (bytecode, error, post-state file path) + let postStateFile = if poststateExists then Just poststateFile else Nothing + return (returnData, errorMsg, postStateFile) -- Build EVM command and execute runtime phase -executeRuntime :: RunSolOptions -> String -> FilePath -> IO (String, Maybe String) -executeRuntime opts bytecode buildDir = do +executeRuntime :: RunSolOptions -> String -> FilePath -> Maybe FilePath -> IO (String, Maybe String) +executeRuntime opts bytecode buildDir poststateFile = do putStrLn "Executing runtime phase..." let traceFile = buildDir "trace.runtime.jsonl" + let receiverAddr = "0x1f2a98889594024BFfdA3311CbE69728d392C06D" -- Prepare runtime calldata if provided let inputOpt = case runtimeCalldataSig opts of @@ -442,10 +532,13 @@ executeRuntime opts bytecode buildDir = do inputArgs <- inputOpt - -- Build evm command + -- Build evm command - use returned bytecode from creation for runtime + let stdinData = bytecode + let codeArgs = ["--codefile", "-"] + let evmCmd = ["evm", "run"] ++ ["--trace", "--trace.nomemory=false", "--trace.noreturndata=false"] - ++ ["--codefile", "-"] + ++ codeArgs ++ inputArgs ++ (case runtimeCallvalue opts of Just v -> ["--value", v] @@ -455,7 +548,7 @@ executeRuntime opts bytecode buildDir = do (exitCode, stdout, stderr) <- readProcessWithExitCode "evm" (tail evmCmd) -- drop "evm" command - bytecode + stdinData -- evm writes to stderr by default, so we need to use that -- Combine both stdout and stderr to handle both cases @@ -464,11 +557,12 @@ executeRuntime opts bytecode buildDir = do when (debugRuntime opts) $ putStrLn $ "Runtime output: " ++ output - -- Save trace - writeFile traceFile output + -- Save trace (filter to only JSON lines) + let jsonLines = unlines $ filter (\l -> not (null l) && head l == '{') (lines output) + writeFile traceFile jsonLines -- Extract actual return data from JSONL output - let (returnData, evmError) = extractEVMResult output + let (returnData, evmError) = extractEVMResult jsonLines -- Debug output when (debugRuntime opts) $ do @@ -477,10 +571,9 @@ executeRuntime opts bytecode buildDir = do putStrLn $ "DEBUG: Extracted error: " ++ show evmError putStrLn $ "DEBUG: First 500 chars: " ++ take 500 output - -- For runtime, preserve execution errors from EVM - let errorMsg = evmError <|> (case exitCode of - ExitFailure code -> Just $ "EVM process failed with exit code " ++ show code - ExitSuccess -> Nothing) + -- For runtime: evm returns exit code 1 on contract execution revert, which is not a failure + -- Only report errors from the JSON output (contract execution), not from exit codes + let errorMsg = evmError return (returnData, errorMsg) @@ -515,24 +608,29 @@ main = do putStrLn "Compiling to bytecode..." let base = dropExtension (takeBaseName (inputFile opts)) let hexFile = buildDir opts base <.> "hex" - bytecode <- compileToBytecode hexFile yulObj + (deploymentBytecode, runtimeBytecode) <- compileToBytecode hexFile yulObj -- Step 4: Execute create phase (if enabled) - when (shouldCreate opts) $ do - (createResult, createError) <- executeCreate opts bytecode (buildDir opts) - - case createError of - Nothing -> do - putStrLn "Creation successful" - unless (null createResult) $ - putStrLn $ "returndata: 0x" ++ createResult - Just err -> do - putStrLn $ "Creation failed: " ++ err - unless (null createResult) $ - putStrLn $ "returndata: 0x" ++ createResult + poststateFile <- if shouldCreate opts + then do + (createResult, createError, psFile) <- executeCreate opts deploymentBytecode (buildDir opts) + + case createError of + Nothing -> do + putStrLn "Creation successful" + unless (null createResult) $ + putStrLn $ "returndata: 0x" ++ createResult + Just err -> do + putStrLn $ "Creation failed: " ++ err + unless (null createResult) $ + putStrLn $ "returndata: 0x" ++ createResult + + return psFile + else + return Nothing -- Step 5: Execute runtime phase - (runtimeResult, runtimeError) <- executeRuntime opts bytecode (buildDir opts) + (runtimeResult, runtimeError) <- executeRuntime opts runtimeBytecode (buildDir opts) poststateFile case runtimeError of Nothing -> do From 378f6e769ccf7b2ca2ace7b7901bde4ad2572ec3 Mon Sep 17 00:00:00 2001 From: Marcin Benke Date: Fri, 2 Jan 2026 10:54:10 +0100 Subject: [PATCH 8/8] Add missing dependencies --- deps/nlohmann_json | 2 +- flake.nix | 2 ++ sol-core.cabal | 3 ++- 3 files changed, 5 insertions(+), 2 deletions(-) diff --git a/deps/nlohmann_json b/deps/nlohmann_json index d33ecd3f3..a0e9fb1e6 160000 --- a/deps/nlohmann_json +++ b/deps/nlohmann_json @@ -1 +1 @@ -Subproject commit d33ecd3f3bd11e30aa8bbabb00e0a9cd3f2456d8 +Subproject commit a0e9fb1e638cfbb5b8b556b7c51eaa81977bad48 diff --git a/flake.nix b/flake.nix index cade2aea8..ff302e70f 100644 --- a/flake.nix +++ b/flake.nix @@ -48,6 +48,8 @@ hspkgs.hevm texlive (pkgs.callPackage ./nix/goevmlab.nix { src = inputs.goevmlab; }) + pkgs.cmake + pkgs.boost ]; }; } diff --git a/sol-core.cabal b/sol-core.cabal index a53b74c22..0faf2dbca 100644 --- a/sol-core.cabal +++ b/sol-core.cabal @@ -156,7 +156,8 @@ executable runsol process, aeson, temporary, - bytestring + bytestring, + text build-tool-depends: alex:alex, happy:happy ghc-options: -O1 default-extensions: