Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

introducing text module

  • Loading branch information...
commit 286f3664f5dad25873036b9a6864c05d44a3a2a9 1 parent 553123c
Alexander Bernauer authored
View
1  bitcoin-script-engine.cabal
@@ -28,6 +28,7 @@ library
Language.Bitcoin.Interpreter
Language.Bitcoin.Parser
Language.Bitcoin.Printer
+ Language.Bitcoin.Text
Language.Bitcoin.Types
Language.Bitcoin.Utils
View
3  src/Language/Bitcoin/Interpreter.hs
@@ -5,11 +5,12 @@ module Language.Bitcoin.Interpreter
import Language.Bitcoin.Types
import Language.Bitcoin.Utils (b2i, i2b)
+import Language.Bitcoin.Text (print_result)
run_interpreter :: Program -> Keyring -> Either String Result
run_interpreter program keyring =
case run_interpreter' (Machine program keyring [] []) of
- result@(Result (Error _) _) -> Left $ show result
+ result@(Result (Error _) _) -> Left $ print_result result
result -> Right result
run_interpreter' :: Machine -> Result
View
3  src/Language/Bitcoin/Main.hs
@@ -5,6 +5,7 @@ import Language.Bitcoin.Interpreter (run_interpreter)
import Language.Bitcoin.Preprocessor (run_preprocessor)
--import Language.Bitcoin.Assembler (run_assembler, run_disassembler)
import Language.Bitcoin.Parser (run_parser)
+import Language.Bitcoin.Text (print_result)
import System.Environment (getArgs, getProgName)
import System.Exit (exitWith, ExitCode(ExitFailure))
import System.IO (stderr, hPutStrLn, hGetContents, hPutStr, hFlush, Handle, stdin, stdout, openFile, IOMode(ReadMode, WriteMode))
@@ -37,7 +38,7 @@ interpreter opts = do
result <- exitOnError $
run_parser name code
>>= (uncurry run_interpreter) . run_preprocessor
- >>= return . show
+ >>= return . print_result
hOut <- fileOut $ optOutput opts
hPutStr hOut result
hFlush hOut
View
2  src/Language/Bitcoin/Options.hs
@@ -62,7 +62,7 @@ available_options :: [OptDescr (Options -> Options)]
available_options = [
Option ['i'] ["input"] (ReqArg (\x opts -> opts {optInput = x}) "input") "input file (default '-')"
, Option ['o'] ["output"] (ReqArg (\x opts -> opts {optOutput = x}) "output") "output file (default '-')"
- , Option ['s'] ["assembler"] (NoArg (\opts -> opts {optSimulator = True})) "run the simulator"
+ , Option ['e'] ["execute"] (NoArg (\opts -> opts {optSimulator = True})) "run the interpreter"
, Option ['a'] ["assembler"] (NoArg (\opts -> opts {optAssembler = True})) "run the assembler"
, Option ['d'] ["disassembler"] (NoArg (\opts -> opts {optDisassembler = True})) "run the disassembler"
, Option ['h'] ["help"] (NoArg (\opts -> opts {optHelp = True})) "print help and quit"
View
51 src/Language/Bitcoin/Text.hs
@@ -0,0 +1,51 @@
+module Language.Bitcoin.Text
+-- export {{{1
+(
+ print_result
+) where
+
+-- import {{{1
+import Language.Bitcoin.Types
+import Data.Char (intToDigit)
+import Data.List (intersperse)
+import Data.Word (Word8)
+import qualified Data.ByteString.Lazy as B
+
+print_result :: Result -> String -- {{{1
+print_result (Result code machine) = print_result_code code ++ "\n" ++ print_machine machine
+
+print_result_code :: ResultCode -> String
+print_result_code Success = "Bitcoin script completed successfully."
+print_result_code (Failure what) = "Bitcoin script failed: " ++ what
+print_result_code (Error what) = "Bitcoin script is illegal: " ++ what
+
+print_machine :: Machine -> String
+print_machine (Machine program _ stack altStack) =
+ concat $ intersperse "\n\t" $ [
+ "Machine:",
+ "program: " ++ print_program program,
+ "stack: " ++ print_stack stack,
+ "alt stack: " ++ print_stack altStack
+ ]
+
+printList :: (a -> String) -> [a] -> String
+printList f lst = "(" ++ (concat $ intersperse ", " $ map f lst) ++ ")"
+
+print_program :: Program -> String
+print_program program = printList print_opcode program
+
+print_data :: B.ByteString -> String
+print_data data_ = concat $ map print_hex $ B.unpack data_
+
+print_stack :: Stack -> String
+print_stack stack = printList print_data stack
+
+print_opcode :: Opcode -> String
+print_opcode (OP_PUSHDATA pushType data_) = "OP_PUSHDATA " ++ show pushType ++ print_data data_
+print_opcode op = show op
+
+print_hex :: Word8 -> String
+print_hex value =
+ let (q, r) = quotRem value 16 in
+ [intToDigit (fromIntegral q), intToDigit (fromIntegral r)]
+
View
16 src/Language/Bitcoin/Types.hs
@@ -2,6 +2,7 @@ module Language.Bitcoin.Types where
-- import {{{1
import qualified Data.ByteString.Lazy as B
import Data.Int (Int32)
+import qualified Data.List as List
-- types {{{1
type Binary = B.ByteString
@@ -23,22 +24,17 @@ data Machine = Machine {
, mchKeyring :: Keyring
, mchStack :: Stack
, mchAltStack :: Stack
- } deriving Show
+ }
data ResultCode =
Success
| Failure String
| Error String
-instance Show ResultCode where
- show Success = "Bitcoin script completed successfully."
- show (Failure what) = "Bitcoin script failed: " ++ what
- show (Error what) = "Bitcoin script is illegal: " ++ what
-data Result = Result ResultCode Machine deriving Show
+data Result = Result ResultCode Machine
--- data Opcode = {{{1
-data Opcode =
+data Opcode = -- {{{1
-- constants {{{2
OP_FALSE
| OP_TRUE
@@ -172,10 +168,10 @@ data PushDataType =
| FourBytes
deriving (Show, Eq, Read)
--- data Command = {{{1
-data Command =
+data Command = -- {{{1
CmdOpcode Opcode
| DATA B.ByteString
| KEY Int32
| SIG Int32
deriving (Show, Eq)
+
View
3  test/Language/Bitcoin/Test/Interpreter.hs
@@ -6,6 +6,7 @@ module Language.Bitcoin.Test.Interpreter
import Language.Bitcoin.Interpreter (run_interpreter')
import Language.Bitcoin.Types
import Language.Bitcoin.Utils
+import Language.Bitcoin.Text (print_result)
import Test.HUnit
tests = TestLabel "Simulator" $ TestList testSimpleOps
@@ -42,4 +43,4 @@ testSimpleOps = map runTest simpleOps
case run_interpreter' (Machine script [] stack []) of
Result Success (Machine _ _ stack' _) -> expected @=? stack'
Result (Failure _) (Machine _ _ stack' _) -> expected @=? stack'
- result -> assertFailure $ show result
+ result -> assertFailure $ print_result result
Please sign in to comment.
Something went wrong with that request. Please try again.