From ca735fe666fbeb732851abd561740967f2591d89 Mon Sep 17 00:00:00 2001 From: z80 Date: Fri, 18 Oct 2024 20:37:27 -0400 Subject: [PATCH] Code cleanup & further implementation --- main.rkt | 18 +++++ parser.rkt | 2 - src/analysis.rkt | 115 +++++++++++++++++++++++++++++ src/assembler.rkt | 177 +++++++++++++++++++++++++++++++++++++++++++++ src/codegen.rkt | 45 ++++++++++++ src/huff-ops.rkt | 162 +++++++++++++++++++++++++++++++++++++++++ src/huffparser.rkt | 21 +++--- src/keccak.rkt | 25 +++++++ src/lexer.rkt | 53 ++------------ src/puff.rkt | 91 +++++++++++++++++++++++ src/utils.rkt | 57 +++++++++++++++ 11 files changed, 710 insertions(+), 56 deletions(-) create mode 100644 main.rkt delete mode 100644 parser.rkt create mode 100644 src/analysis.rkt create mode 100644 src/assembler.rkt create mode 100644 src/codegen.rkt create mode 100644 src/huff-ops.rkt create mode 100644 src/keccak.rkt create mode 100644 src/utils.rkt diff --git a/main.rkt b/main.rkt new file mode 100644 index 0000000..c3a59cc --- /dev/null +++ b/main.rkt @@ -0,0 +1,18 @@ +#lang racket +(require racket/cmdline "src/puff.rkt") + +(define filename "") + +(define compilation-output 'bytecode) + +(command-line + #:program "puff" + #:once-any + [("-b" "--bytecode") "Output bytecode" (set! compilation-output 'bytecode)] + [("-r" "--runtime-bytecode") "Output runtime bytecode" (set! compilation-output 'runtime)] + #:args (f) + (set! filename f)) + +(match compilation-output + ['bytecode (displayln (compile-filename filename))] + ['runtime (displayln (compile-filename-runtime filename))]) diff --git a/parser.rkt b/parser.rkt deleted file mode 100644 index 7c11107..0000000 --- a/parser.rkt +++ /dev/null @@ -1,2 +0,0 @@ -#lang brag -huff-program: ">"* diff --git a/src/analysis.rkt b/src/analysis.rkt new file mode 100644 index 0000000..f4dd70a --- /dev/null +++ b/src/analysis.rkt @@ -0,0 +1,115 @@ +#lang racket + +(require "lexer.rkt" + "huffparser.rkt" + "utils.rkt" + threading) + +;; some structs, for convenience getter/setter methods +;; program-data will contain all the data required to compile a contract +(struct program-data (labels + macros + functions + fndecls + eventdefs + errordefs + constants + errors + includes + ctx) #:mutable) + +;; no-arg constructor +(define (make-program-data) + (program-data (make-hash) + (make-hash) + (make-hash) + (make-hash) + (make-hash) + (make-hash) + (make-hash) + (make-hash) + (list) + (make-hash))) + +;; not really needed, but a struct for a specific macro's data +;; TODO: decide if we should get rid of this and just use the list +(struct macro-data (args takes returns body)) + +;; constructor +(define (make-macro-data defmacro) + (apply macro-data defmacro)) + + +;; analyze all top-level nodes, outputting into the same data object +(define (analyze-program program data) + (for-each (lambda (n) (analyze-node n data)) (rest program))) + +;; save each macro body in the data object +(define (analyze-defmacro defmacro data) + (match defmacro + [(list 'defmacro identifier args takes returns body) (hash-set! (program-data-macros data) identifier (list args takes returns body))] + [_ (error "Invalid defmacro")])) + +;; save each function body in the data object +(define (analyze-defn defn data) + (match defn + [(list 'defn identifier args takes returns body) (hash-set! (program-data-functions data) identifier (list args takes returns body))] + [_ (error "Invalid defn")])) + +;; save each constant value in the data object +(define (analyze-defconst defconst data) + (match defconst + [(list 'defconst identifier value) (hash-set! (program-data-constants data) identifier value)] + [_ (error "Invalid defconst")])) + +#| IMPORT HANDLING |# +;; macro to save the current context and restore it after the analysis +;; this is used for includes, which need to know the current file's directory +;; so we temporarily set the context to one with the include's filename +(define-syntax with-temp-context + (syntax-rules () + [(_ data ctx body ...) + (let ([old-ctx (program-data-ctx data)]) + (set-program-data-ctx! data ctx) + (begin + body ... + (set-program-data-ctx! data old-ctx)))])) + +(define (analyze-filename filename data) + (let ([parse-tree (~> filename + file->string + lex + parse + syntax->datum)]) + (with-temp-context data (hash 'filename filename) + (analyze-node parse-tree data)))) + +(define (analyze-include inc data) + (let* ([current-file (hash-ref (program-data-ctx data) 'filename)] + [current-dir (path->string (path-only (path->complete-path current-file)))]) + (parameterize ([current-directory current-dir]) + (match inc + [(list 'include filename) (let* ([filename (string-append current-dir (format-filename filename))]) + (set-program-data-includes! data (cons filename (program-data-includes data))) + (analyze-filename filename data))] + [_ (error "Invalid include")])))) +#| END IMPORT HANDLING |# + + +;; top-level node-handler function +(define (analyze-node node [data #f] [ctx #f]) + (let ([data (or data (make-program-data))]) + (when ctx (set-program-data-ctx! data ctx)) + (match (first node) + ['program (analyze-program node data)] + ['defmacro (analyze-defmacro node data)] + ['include (analyze-include node data)] + ['defconst (analyze-defconst node data)] + ['defn (analyze-defn node data)]) + data)) + +(provide (struct-out program-data) + (struct-out macro-data) + make-program-data + make-macro-data + analyze-node) diff --git a/src/assembler.rkt b/src/assembler.rkt new file mode 100644 index 0000000..66156d7 --- /dev/null +++ b/src/assembler.rkt @@ -0,0 +1,177 @@ +#lang racket + +#| + This module provides a simple assembler for Ethereum Virtual Machine (EVM) opcodes. + It provides a mapping from opcode names to their hexadecimal values, and functions + to convert between opcode names and their hexadecimal values. + + The module also provides functions to convert between bytes and hexadecimal strings. +|# + +(define opcode-map + (hash "STOP" #x00 + "ADD" #x01 + "MUL" #x02 + "SUB" #x03 + "DIV" #x04 + "SDIV" #x05 + "MOD" #x06 + "SMOD" #x07 + "ADDMOD" #x08 + "MULMOD" #x09 + "EXP" #x0a + "SIGNEXTEND" #x0b + "LT" #x10 + "GT" #x11 + "SLT" #x12 + "SGT" #x13 + "EQ" #x14 + "ISZERO" #x15 + "AND" #x16 + "OR" #x17 + "XOR" #x18 + "NOT" #x19 + "BYTE" #x1a + "SHL" #x1b + "SHR" #x1c + "SAR" #x1d + "KECCAK256" #x20 + "ADDRESS" #x30 + "BALANCE" #x31 + "ORIGIN" #x32 + "CALLER" #x33 + "CALLVALUE" #x34 + "CALLDATALOAD" #x35 + "CALLDATASIZE" #x36 + "CALLDATACOPY" #x37 + "CODESIZE" #x38 + "CODECOPY" #x39 + "GASPRICE" #x3a + "EXTCODESIZE" #x3b + "EXTCODECOPY" #x3c + "RETURNDATASIZE" #x3d + "RETURNDATACOPY" #x3e + "EXTCODEHASH" #x3f + "BLOCKHASH" #x40 + "COINBASE" #x41 + "TIMESTAMP" #x42 + "NUMBER" #x43 + "PREVRANDAO" #x44 + "GASLIMIT" #x45 + "CHAINID" #x46 + "SELFBALANCE" #x47 + "BASEFEE" #x48 + "BLOBHASH" #x49 + "BLOBBASEFEE" #x4a + "POP" #x50 + "MLOAD" #x51 + "MSTORE" #x52 + "MSTORE8" #x53 + "SLOAD" #x54 + "SSTORE" #x55 + "JUMP" #x56 + "JUMPI" #x57 + "PC" #x58 + "MSIZE" #x59 + "GAS" #x5a + "JUMPDEST" #x5b + "TLOAD" #x5C + "TSTORE" #x5D + "MCOPY" #x5E + "PUSH0" #x5F + "PUSH1" #x60 + "PUSH2" #x61 + "PUSH3" #x62 + "PUSH4" #x63 + "PUSH5" #x64 + "PUSH6" #x65 + "PUSH7" #x66 + "PUSH8" #x67 + "PUSH9" #x68 + "PUSH10" #x69 + "PUSH11" #x6A + "PUSH12" #x6B + "PUSH13" #x6C + "PUSH14" #x6D + "PUSH15" #x6E + "PUSH16" #x6F + "PUSH17" #x70 + "PUSH18" #x71 + "PUSH19" #x72 + "PUSH20" #x73 + "PUSH21" #x74 + "PUSH22" #x75 + "PUSH23" #x76 + "PUSH24" #x77 + "PUSH25" #x78 + "PUSH26" #x79 + "PUSH27" #x7A + "PUSH28" #x7B + "PUSH29" #x7C + "PUSH30" #x7D + "PUSH31" #x7E + "PUSH32" #x7F + "DUP1" #x80 + "DUP2" #x81 + "DUP3" #x82 + "DUP4" #x83 + "DUP5" #x84 + "DUP6" #x85 + "DUP7" #x86 + "DUP8" #x87 + "DUP9" #x88 + "DUP10" #x89 + "DUP11" #x8A + "DUP12" #x8B + "DUP13" #x8C + "DUP14" #x8D + "DUP15" #x8E + "DUP16" #x8F + "SWAP1" #x90 + "SWAP2" #x91 + "SWAP3" #x92 + "SWAP4" #x93 + "SWAP5" #x94 + "SWAP6" #x95 + "SWAP7" #x96 + "SWAP8" #x97 + "SWAP9" #x98 + "SWAP10" #x99 + "SWAP11" #x9A + "SWAP12" #x9B + "SWAP13" #x9C + "SWAP14" #x9D + "SWAP15" #x9E + "SWAP16" #x9F + "LOG0" #xA0 + "LOG1" #xA1 + "LOG2" #xA2 + "LOG3" #xA3 + "LOG4" #xA4 + "CREATE" #xF0 + "CALL" #xF1 + "CALLCODE" #xF2 + "RETURN" #xF3 + "DELEGATECALL" #xF4 + "CREATE2" #xF5 + "STATICCALL" #xFA + "REVERT" #xFD + "INVALID" #xFE + "SELFDESTRUCT" #xFF)) + +(define opcodes (hash-keys opcode-map)) + +(define (byte->opcode) + (let ([byte (read-byte)]) + (hash-ref opcode-map byte))) + +(define (assemble-opcode opcode) + (cond + [(hash-has-key? opcode-map opcode) (hash-ref opcode-map opcode)] + [(string-prefix? opcode "0x") (string->number (substring opcode 2) 16)] + [else (error "Unknown opcode" opcode)])) + +(define (assemble-opcodes opcodes) + (map assemble-opcode opcodes)) + +(provide opcode-map opcodes assemble-opcode assemble-opcodes) diff --git a/src/codegen.rkt b/src/codegen.rkt new file mode 100644 index 0000000..a2e47fd --- /dev/null +++ b/src/codegen.rkt @@ -0,0 +1,45 @@ +#lang racket +(require "huff-ops.rkt" + "utils.rkt" + threading) + +;; in this file: functions to generate actual opcodes +;; this means: +;; - huff instructions like mstore become "MSTORE" +;; - hex values like "0x20" become "PUSH1 0x20" +;; - constructor generators + +(define (handle-val val) + (cond + [(instruction? val) (list (instruction->opcode val))] + [else (begin + (displayln (format "Unknown value: ~a" val)) + (list (string-upcase (symbol->string val))))])) + +(define (handle-hex val) + (if (equal? val "0x00") + (list "PUSH0") + (let* ( + [num-bytes (ceiling (/ (- (string-length val) 2) 2))] + [push-instr (string-append "PUSH" (number->string num-bytes))]) + (list push-instr val)))) + +(define (handle-expr expr) + (match (first expr) + ['hex (handle-hex (second expr))] + ['const-ref (list expr)] + ['body (apply append (map handle-tree (rest expr)))])) + +(define (handle-tree tree) + (if (list? tree) + (handle-expr tree) + (handle-val tree))) + +(define (generate-copy-constructor sz) + (let ([sz-hex-str (string-append "0x" (number->string sz 16))]) + (append (handle-hex sz-hex-str) '("DUP1" "PUSH1" "0x09" "RETURNDATASIZE" "CODECOPY" "RETURNDATASIZE" "RETURN")))) + +(provide handle-tree + handle-hex + handle-val + generate-copy-constructor) diff --git a/src/huff-ops.rkt b/src/huff-ops.rkt new file mode 100644 index 0000000..99c4aab --- /dev/null +++ b/src/huff-ops.rkt @@ -0,0 +1,162 @@ +#lang racket + +(define huff-instructions + '("add" + "addmod" + "address" + "and" + "balance" + "basefee" + "blobbasefee" + "blobhash" + "blockhash" + "byte" + "call" + "callcode" + "calldatacopy" + "calldataload" + "calldatasize" + "caller" + "callvalue" + "chainid" + "codecopy" + "codesize" + "coinbase" + "create" + "create2" + "delegatecall" + "div" + "dup1" + "dup10" + "dup11" + "dup12" + "dup13" + "dup14" + "dup15" + "dup16" + "dup2" + "dup3" + "dup4" + "dup5" + "dup6" + "dup7" + "dup8" + "dup9" + "eq" + "exp" + "extcodecopy" + "extcodehash" + "extcodesize" + "gas" + "gaslimit" + "gasprice" + "gt" + "invalid" + "iszero" + "jump" + "jumpdest" + "jumpi" + "keccak256" + "log0" + "log1" + "log2" + "log3" + "log4" + "lt" + "mcopy" + "mload" + "mod" + "msize" + "mstore" + "mstore8" + "mul" + "mulmod" + "not" + "number" + "or" + "origin" + "pc" + "pop" + "prevrandao" + "push0" + "push1" + "push10" + "push11" + "push12" + "push13" + "push14" + "push15" + "push16" + "push17" + "push18" + "push19" + "push2" + "push20" + "push21" + "push22" + "push23" + "push24" + "push25" + "push26" + "push27" + "push28" + "push29" + "push3" + "push30" + "push31" + "push32" + "push4" + "push5" + "push6" + "push7" + "push8" + "push9" + "return" + "returndatacopy" + "returndatasize" + "revert" + "sar" + "sdiv" + "selfbalance" + "selfdestruct" + "sgt" + "shl" + "shr" + "signextend" + "sload" + "slt" + "smod" + "sstore" + "staticcall" + "stop" + "sub" + "swap1" + "swap10" + "swap11" + "swap12" + "swap13" + "swap14" + "swap15" + "swap16" + "swap2" + "swap3" + "swap4" + "swap5" + "swap6" + "swap7" + "swap8" + "swap9" + "timestamp" + "tload" + "tstore" + "xor")) + +(define (instruction? op) + (member op huff-instructions)) + +(define (instruction->opcode op) + (if (instruction? op) + (string-upcase op) + (error 'huffop->opcode "not a huff opcode" op))) + +(provide huff-instructions instruction? instruction->opcode) diff --git a/src/huffparser.rkt b/src/huffparser.rkt index 51e70f1..b8b3901 100644 --- a/src/huffparser.rkt +++ b/src/huffparser.rkt @@ -1,22 +1,25 @@ #lang brag program : @top-level* -top-level : (function-abi-definition | event-abi-definition | deferror | defconst | macro-definition | fn-definition | include | COMMENT)* +top-level : (declfn | event-abi-definition | deferror | defconst | defmacro | defn | include | COMMENT)* include: /INCLUDE STRING -function-abi-definition : FUNCDEFINE +declfn : FUNCDECLARE event-abi-definition: EVENTDEFINE deferror : /DEFINE /ERROR IDENTIFIER args -defconst : /DEFINE /CONSTANT IDENTIFIER /EQUALS (HEX | FREE-STORAGE-POINTER) +defconst : /DEFINE /CONSTANT IDENTIFIER /EQUALS (hex | FREE-STORAGE-POINTER) deftable : /DEFINE /TABLE IDENTIFIER scope -macro-definition : /DEFINE /MACRO IDENTIFIER args /EQUALS takes returns scope -fn-definition : /DEFINE /FN IDENTIFIER args /EQUALS takes returns scope +defmacro : /DEFINE /MACRO IDENTIFIER args /EQUALS takes returns @scope +defn : /DEFINE /FN IDENTIFIER args /EQUALS takes returns @scope args : /LPAREN @identifierlist* /RPAREN takes : /TAKES /LPAREN NUMBER /RPAREN returns : /RETURNS /LPAREN NUMBER /RPAREN scope : /LBRACE body /RBRACE -body : (HEX | invocation | label | macro-arg | label-ref | IDENTIFIER | /COMMENT)* +body : (hex | fncall | label | macro-arg | const-ref | IDENTIFIER | /COMMENT)* macro-arg : /LT IDENTIFIER /GT label: IDENTIFIER /COLON -label-ref : /LBRACKET IDENTIFIER /RBRACKET -invocation : IDENTIFIER /LPAREN @identifierlist* /RPAREN scope? +const-ref : /LBRACKET IDENTIFIER /RBRACKET +fncall : IDENTIFIER args +fncall-with-scope : IDENTIFIER /LPAREN @identifierlist* /RPAREN @scope? identifierlist : @ident (COMMA @ident)* -ident : (IDENTIFIER | macro-arg | HEX | NUMBER) +ident : (IDENTIFIER | macro-arg | hex | NUMBER) +hex : HEX +opcode: OPCODE diff --git a/src/keccak.rkt b/src/keccak.rkt new file mode 100644 index 0000000..959ff41 --- /dev/null +++ b/src/keccak.rkt @@ -0,0 +1,25 @@ +#lang racket + +(require ffi/unsafe ffi/unsafe/define "assembler.rkt" threading) +(require racket/runtime-path) + +(define-runtime-path libkeccak "../lib/libkeccak_lib.so") + +(define-ffi-definer define-keccak (ffi-lib libkeccak)) + +(define-keccak keccak256 (_fun _pointer _size _pointer -> _void)) + +(define (string->keccak256 input) + (~> input + string->bytes/utf-8 + bytes->keccak256)) + +(define (bytes->keccak256 input) + (let* ([input-len (bytes-length input)] + [buffer (make-bytes input-len)] + [output (make-bytes 32)]) + (bytes-copy! buffer 0 input) + (keccak256 buffer input-len output) + (subbytes output 0 32))) + +(provide string->keccak256 bytes->keccak256) diff --git a/src/lexer.rkt b/src/lexer.rkt index 9dd0ecd..676ad07 100644 --- a/src/lexer.rkt +++ b/src/lexer.rkt @@ -3,10 +3,9 @@ (define-lex-abbrevs [digits (:+ (char-set "0123456789"))] - [str (:seq "\"" (:+ (char-set "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789./")) "\"")] + [str (:seq "\"" (:+ (char-set "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789./")) "\"")] [digitsOrLetters (:+ (char-set "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_"))] [hex-digits (:+ (char-set "0123456789abcdefABCDEF"))] - [opcode (:or huff-ops)] [hex-literal (:seq "0x" hex-digits)] [funcdef (from/stop-before (:seq "#define function ") (:or " /" "\n"))] [eventdef (from/stop-before (:seq "#define event ") (:or " /" "\n"))] @@ -34,21 +33,21 @@ [";" (token 'SEMICOLON lexeme)] [whitespace (token lexeme #:skip? #t)] ["#define" (token 'DEFINE lexeme)] - ["#include" (token 'INCLUDE lexeme)] + ["#include" (token 'INCLUDE lexeme)] ["macro" (token 'MACRO lexeme)] ["function" (token 'FUNCTION lexeme)] ["fn" (token 'FN lexeme)] ["event" (token 'EVENT lexeme)] ["error" (token 'ERROR lexeme)] ["constant" (token 'CONSTANT lexeme)] - ["table" (token 'TABLE lexeme)] + ["table" (token 'TABLE lexeme)] ["takes" (token 'TAKES lexeme)] ["returns" (token 'RETURNS lexeme)] [comment (token 'COMMENT lexeme)] [digits (token 'NUMBER lexeme)] [str (token 'STRING lexeme)] [hex-literal (token 'HEX lexeme)] - [funcdef (token 'FUNCDEFINE lexeme)] + [funcdef (token 'FUNCDECLARE lexeme)] [eventdef (token 'EVENTDEFINE lexeme)] [identifier (token 'IDENTIFIER lexeme)] [free-storage-pointer (token 'FREE-STORAGE-POINTER lexeme)] @@ -56,44 +55,8 @@ [any-char (token 'OTHER lexeme)])) -;;(provide basic-lexer) +;; port can be a string or a file +(define (lex port) + (apply-port-proc basic-lexer port)) -(define (print-parse-tree tree [indent 0]) - (define (print-indent) - (for ([i (in-range indent)]) - (display " "))) - - (cond - [(list? tree) - (print-indent) - (printf "(~a\n" (car tree)) - (for ([item (in-list (cdr tree))]) - (print-parse-tree item (add1 indent))) - (print-indent) - (display ")\n")] - [else - (print-indent) - (printf "~a\n" tree)])) - -(define (lex str) - (apply-port-proc basic-lexer str)) - - - - -;; iterate over each file under examples and parse it -(define (parse-all-examples) - (for ([file (in-directory "examples")]) - ;; skip if is a directory - (unless (directory-exists? file) - (define program (file->string file)) - ;; print filename - (display "Parsing ") - (display file) - (display "... ") - (define parse-tree (parse (lex program))) - (print-color "OK" 'green) - (newline) - (syntax->datum parse-tree)))) - -(parse-all-examples) +(provide lex) diff --git a/src/puff.rkt b/src/puff.rkt index e69de29..b8ec92e 100644 --- a/src/puff.rkt +++ b/src/puff.rkt @@ -0,0 +1,91 @@ +#lang racket +(require racket/list + threading + "lexer.rkt" + "huffparser.rkt" + "huff-ops.rkt" + "assembler.rkt" + "keccak.rkt" + "huff-ops.rkt" + "utils.rkt" + "codegen.rkt" + "analysis.rkt") + +(define (compile-macro macro-data) + (let ([args (macro-data-args macro-data)] + [takes (macro-data-takes macro-data)] + [returns (macro-data-returns macro-data)] + [body (macro-data-body macro-data)]) + (handle-tree body))) + +;; replace all `(const-ref const) with the actual value of the constant from the hashmap +(define (handle-const-ref code constants) + (match code + [(list 'const-ref const) + (handle-tree (hash-ref constants const))] + [_ code])) + +(define (make-const-handler constants) + (lambda (code) + (handle-const-ref code constants))) + +(define (insert-constants code constants) + (let* ([handler (make-const-handler constants)] + [res (map handler code)]) + (flatten res))) + +(define (compile-program-data-runtime data) + (let* ([main-macro (hash-ref (program-data-macros data) "MAIN")] + [main-macro-data (make-macro-data main-macro)] + [constants (program-data-constants data)] + [compiled-macro (compile-macro main-macro-data)]) + (~> compiled-macro + (insert-constants constants) + assemble-opcodes))) + +(define (compile-program-data data) + (let* ([compiled-runtime (compile-program-data-runtime data)] + [sz (byte-length compiled-runtime)] + [initcode (generate-copy-constructor sz)] + [assembled-initcode (assemble-opcodes initcode)]) + (append assembled-initcode compiled-runtime))) + +(define (compile-src src) + (~> src + lex + parse + syntax->datum + analyze-node + compile-program-data + bytes->hex)) + +(define (compile-src-runtime src) + (~> src + lex + parse + syntax->datum + analyze-node + compile-program-data-runtime + bytes->hex)) + +(define (compile-filename filename) + (~> filename + file->string + lex + parse + syntax->datum + (analyze-node #f (hash 'filename filename)) + compile-program-data + bytes->hex)) + +(define (compile-filename-runtime filename) + (~> filename + file->string + lex + parse + syntax->datum + (analyze-node #f (hash 'filename filename)) + compile-program-data-runtime + bytes->hex)) + +(provide compile-filename compile-src compile-filename-runtime compile-src-runtime) diff --git a/src/utils.rkt b/src/utils.rkt new file mode 100644 index 0000000..adc0347 --- /dev/null +++ b/src/utils.rkt @@ -0,0 +1,57 @@ +#lang racket + +(require threading) + +(define (print-color text color) + (define color-code + (case color + [(black) "30"] + [(red) "31"] + [(green) "32"] + [(yellow) "33"] + [(blue) "34"] + [(magenta) "35"] + [(cyan) "36"] + [(white) "37"] + [else "0"])) ; default to normal text + + (printf "\033[~am~a\033[0m" color-code text)) + +(define (bold text) + (format "\033[1m~a\033[0m" text)) + +(define (number->hex num) + (let ([num-str (number->string num 16)]) + (if (even? (string-length num-str)) + (string-append "0x" num-str) + (string-append "0x0" num-str)))) + +(define (byte-length code) + (apply + (for/list ([c code]) + (~> c + number->hex + string-length + (- 2) + (/ 2))))) + +(define (byte->hex byte) + (let ([hex (number->string byte 16)]) + (if (= (string-length hex) 1) + (string-append "0" hex) + hex))) + +(define (bytes->hex bytes) + (string-append "0x" (apply string-append (map byte->hex bytes)))) + +(define (format-filename filename) + (~> filename + (string-trim "\"") + (string-trim "./"))) + +(provide print-color + bold + number->hex + byte-length + format-filename + byte->hex + bytes->hex)