text:
(* This is free and unencumbered software released into the public domain. *)

module Feature = struct
  type t =
    | None
    | NoDeploy
    | OnlyFunction of string

  let of_string s =
    match String.split_on_char '=' s with
    | [] -> Ok None
    | ["no-deploy"] -> Ok NoDeploy
    | ["only-function"; fn] -> Ok (OnlyFunction fn)
    | _ -> Error (`Msg "invalid feature flag")

  let to_string = function
    | None -> ""
    | NoDeploy -> "no-deploy"
    | OnlyFunction fn -> Printf.sprintf "only-function=%s" fn
end


text:
(* This is free and unencumbered software released into the public domain. *)

val compile_contract : ?features:(Feature.t list) -> Clarity.program -> EVM.contract

repo_name: weavery/clarc

repo_language: OCaml

mime_type: text/plain


text:
(* This is free and unencumbered software released into the public domain. *)

type context =
  { global_vars: string list;
    global_funs: string list;
    local_vars: (string * int) list; }

let make_context global_vars global_funs local_vars =
  { global_vars; global_funs; local_vars; }

let extend_context context local_vars =
  { global_vars = context.global_vars;
    global_funs = context.global_funs;
    local_vars = local_vars @ context.local_vars; }

let _dump_context context =
  let dump_local_var (n, i) = Printf.eprintf "\t(%s, %d)" n i in
  Printf.eprintf "local_vars=%d\t" (List.length context.local_vars);
  List.iter dump_local_var context.local_vars

let unimplemented_function name type' =
  unimplemented (Printf.sprintf "(%s %s)" name (Clarity.type_to_string type'))

let unsupported_function name type' =
  unsupported (Printf.sprintf "(%s %s)" name (Clarity.type_to_string type'))

let unsupported_function2 name type1 type2 =
  let typename1 = Clarity.type_to_string type1 in
  let typename2 = Clarity.type_to_string type2 in
  unsupported (Printf.sprintf "(%s %s %s)" name typename1 typename2)

let error_in_function name message =
  failwith (Printf.sprintf "%s: %s" name message)

let rec compile_contract ?(features=[]) program =
  let only_f = function Feature.OnlyFunction fn -> Some fn | _ -> None in
  let only_function = List.find_map only_f features in
  let no_deploy =
    match only_function with
    | Some _ -> true
    | None -> List.memq Feature.NoDeploy features
  in
  let is_var = function
    | Clarity.Constant _ | DataVar _ | Map _ -> true
    | _ -> false
  in
  let name_of = function
    | Clarity.Constant (name, _)
    | DataVar (name, _, _)
    | Map (name, _, _)
    | PrivateFunction (name, _, _)
    | PublicFunction (name, _, _)
    | PublicReadOnlyFunction (name, _, _) -> name
  in
  let (vars, funs) = List.partition is_var program in
  match only_function with
  | Some fn ->
    let funs = funs |> List.filter (fun f -> fn = name_of f) in
    let globals = make_context (List.map name_of vars) (List.map name_of funs) [] in
    let program = compile_program features globals funs in
    let payload = link_program program in
    ([], payload)
  | None ->
    let globals = make_context (List.map name_of vars) (List.map name_of funs) [] in
    let dispatcher = compile_dispatcher funs in
    let program = compile_program features globals funs in
    let payload = link_program (dispatcher @ program) in
    let deployer = if no_deploy then [] else compile_deployer globals vars payload in
    (deployer, payload)

and compile_deployer env vars payload =
  let inits = List.concat (List.mapi (compile_var env) vars) in
  let loader_length = 11 in  (* keep in sync with bytecode below *)
  let loader = [
    EVM.from_int (EVM.program_size payload);
    EVM.DUP 1;
    EVM.from_int (loader_length + (EVM.opcodes_size inits));
    EVM.zero;
    EVM.CODECOPY;
    EVM.zero;           (* offset = memory address 0 *)
    EVM.RETURN;         (* RETURN offset, length *)
  ] in
  [(0, inits @ loader)]

and compile_var env index = function
  | Clarity.Constant _ ->
    unimplemented "define-constant"  (* TODO *)
  | DataVar (_name, _type', value) ->
    let value = compile_expression env value in
    EVM.sstore index value
  | Map (_name, _, _) ->
    let value = [EVM.zero] in  (* TODO: store the byte size of the value tuple? *)
    EVM.sstore index value
  | _ -> unreachable ()

and compile_dispatcher program =
  let prelude = [
    EVM.from_int 0xE0;  (* b = 224 *)
    EVM.from_int 0x02;  (* a = 2 *)
    EVM.EXP;            (* EXP a, b (2^224) *)
    EVM.zero;           (* i = 0 *)
    EVM.CALLDATALOAD;   (* CALLDATALOAD i *)
    EVM.DIV;            (* DIV a, b *)
  ] in
  let tests = List.concat (List.mapi compile_dispatcher_test program) in
  let postlude = EVM.stop in
  [(0, prelude @ tests @ postlude)]

and compile_dispatcher_test index = function
  | Clarity.Constant _ | DataVar _ | Map _ -> unreachable ()
  | PrivateFunction _ -> []
  | PublicFunction (name, params, _)
  | PublicReadOnlyFunction (name, params, _) ->
    let hash = function_hash name params in
    let dest = 1 + index in
    [
      EVM.DUP 1;        (* b = top of stack *)
      EVM.PUSH (4, hash);  (* a = keccak256(function_sig)[:4] *)
      EVM.EQ;           (* cond = EQ a, b *)
      EVM.from_int dest;   (* dest = the function prelude *)
      EVM.JUMPI;        (* JUMPI dest, cond *)
    ]

and compile_program features env program =
  List.mapi (compile_definition features env) program

and compile_definition features env index = function
  | Clarity.Constant _ | DataVar _ | Map _ -> unreachable ()
  | PrivateFunction func -> compile_private_function features env index func
  | PublicFunction func -> compile_public_function features env index func ~response_only:true
  | PublicReadOnlyFunction func -> compile_public_function features env index func ~response_only:false

and compile_public_function ?(response_only=false) features env index (name, _, body) =
  let only_f = function Feature.OnlyFunction fn -> Some fn | _ -> None in
  let only_function = List.find_map only_f features in
  let prelude =
    match only_function with
    | Some _ -> []
    | None -> [
        EVM.JUMPDEST;       (* the contract dispatcher will jump here *)
        EVM.POP;            (* clean up from the dispatcher logic *)
        (* TODO: fetch function arguments *)
      ]
  in
  let rec compile_body_with_response_return = function
    | [] -> error_in_function name "function body is empty"
    | [Clarity.Ok expr]
    | [Clarity.Err expr] -> [compile_expression env expr]
    | [expr] ->
      begin match type_of_expression expr with
      | Response _ -> [compile_expression env expr]
      | _ -> error_in_function name "function must return (ok) or (err)"
      end
    | expr :: exprs -> compile_expression env expr :: compile_body_with_response_return exprs
  in
  let compile_body_with_any_return = function
    | [] -> error_in_function name "function body is empty"
    | exprs -> List.map (compile_expression env) exprs
  in
  let compile_body = if response_only
    then compile_body_with_response_return
    else compile_body_with_any_return
  in
  let body = compile_body body |> List.concat in
  let postlude =        (* (ok ...) or (err ...) expected on top of stack *)
    EVM.mstore 0 []
    @ EVM.return1
    @ EVM.stop          (* redundant, but a good marker for EOF *)
  in
  (1 + index, prelude @ body @ postlude)

and compile_private_function _features env index (_, _, body) =
  let prelude = EVM.jumpdest in  (* the calling function will jump here, with the return PC on TOS *)
  let body = List.concat_map (compile_expression env) body in
  let postlude = [      (* return value expected on top of stack *)
    EVM.SWAP 1;         (* destination, result -- result, destination *)
    EVM.JUMP;           (* JUMP destination *)
  ] @ EVM.stop          (* redundant, but a good marker for EOF *)
  in
  (1 + index, prelude @ body @ postlude)

and compile_expression env = function
  | Literal lit -> compile_literal lit
  | TupleExpression [("key", key)] -> compile_expression env key
  | TupleExpression _ -> unimplemented "arbitrary tuple expressions"  (* TODO *)

  | Add [a; b] ->
    let a = compile_expression env a in
    let b = compile_expression env b in
    EVM.add a b  (* TODO: handle overflow *)

  | And [a; b] ->
    let a = compile_expression env a in
    let b = compile_expression env b in
    EVM.and' a b

  | DefaultTo (default_value, option_value) ->
    begin match type_of_expression option_value with
    | Optional _ ->
      let cond_value = compile_expression env option_value in
      let some_block = [] in  (* top of stack contains the unpacked value *)
      let none_block = compile_expression env default_value in
      compile_branch cond_value some_block none_block
    | t -> unsupported_function "default-to" t
    end

  | Div [a; b] ->
    let a = compile_expression env a in
    let b = compile_expression env b in
    EVM.div a b  (* TODO: handle division by zero *)

  | Err x -> compile_expression env x @ [EVM.zero]

  | Ge (a, b) ->
    let a = compile_expression env a in
    let b = compile_expression env b in
    EVM.ge a b  (* TODO: signed vs unsigned *)

  | Gt (a, b) ->
    let a = compile_expression env a in
    let b = compile_expression env b in
    EVM.gt a b  (* TODO: signed vs unsigned *)

  | Identifier id -> (* _dump_context env; *)
    begin match List.find_opt (fun (name, _) -> name = id) env.local_vars with
    | None -> failwith (Printf.sprintf "unbound variable: %s" id)
    | Some (_, local_var_index) ->
      let stack_slot = (List.length env.local_vars) - local_var_index in
      EVM.dup stack_slot
    end

  | If (cond_expr, then_branch, else_branch) ->
    begin match type_of_expression cond_expr with
    | Bool ->
      let cond_value = compile_expression env cond_expr in
      let then_block = compile_expression env then_branch in
      let else_block = compile_expression env else_branch in
      compile_branch cond_value then_block else_block
    | t -> unsupported_function "if" t
    end

  | IsEq [a; b] ->
    begin match type_of_expression a, type_of_expression b with
    | a_type, b_type when a_type = b_type ->
      let a = compile_expression env a in
      let b = compile_expression env b in
      EVM.eq a b
    | a_type, b_type -> unsupported_function2 "is-eq" a_type b_type
    end

  | IsErr x ->
    begin match type_of_expression x with
    | Response _ -> compile_expression env x |> EVM.iszero
    | t -> unsupported_function "is-err" t
    end

  | IsNone x ->
    begin match type_of_expression x with
    | Optional _ -> compile_expression env x |> EVM.iszero
    | t -> unsupported_function "is-none" t
    end

  | IsOk x ->
    begin match type_of_expression x with
    | Response _ -> compile_expression env x @ [EVM.ISZERO; EVM.ISZERO]
    | t -> unsupported_function "is-ok" t
    end

  | IsSome x ->
    begin match type_of_expression x with
    | Optional _ -> compile_expression env x @ [EVM.ISZERO; EVM.ISZERO]
    | t -> unsupported_function "is-some" t
    end

  | Le (a, b) ->
    let a = compile_expression env a in
    let b = compile_expression env b in
    EVM.le a b  (* TODO: signed vs unsigned *)

  | Len x ->
    begin match type_of_expression x with
    | String (n, _) | Buff n | List (n, _) -> [EVM.from_int n]
    | t -> unsupported_function "len" t
    end

  | Let (bindings, body) ->
    let local_var_count = List.length env.local_vars in
    let compile_binding_index index (name, _) = (name, local_var_count + index) in
    let compile_binding_expr (_, expr) = compile_expression env expr in
    let env = extend_context env (List.mapi compile_binding_index bindings) in
    let last_body_index = (List.length body) - 1 in
    let compile_body_expr index expr =
      compile_expression env expr @
        if index < last_body_index then EVM.pop1 else []
    in
    List.map compile_binding_expr bindings @
      List.mapi compile_body_expr body |> List.concat

  | ListExpression xs ->
    List.concat_map (compile_expression env) xs @ [EVM.from_int (List.length xs)]

  | Lt (a, b) ->
    let a = compile_expression env a in
    let b = compile_expression env b in
    EVM.lt a b  (* TODO: signed vs unsigned *)

  | Match (input_expr, (_, some_branch), (_, none_branch)) ->
    let input_value = compile_expression env input_expr in
    let some_block = compile_expression env some_branch in
    let none_block = compile_expression env none_branch in
    input_value @ compile_branch [EVM.ISZERO] (EVM.pop @ none_block) some_block

  | Mod (a, b) ->
    let a = compile_expression env a in
    let b = compile_expression env b in
    EVM.mod' a b  (* TODO: handle division by zero *)

  | Mul [a; b] ->
    let a = compile_expression env a in
    let b = compile_expression env b in
    EVM.mul a b  (* TODO: handle overflow *)

  | Not x ->
    let x = compile_expression env x in
    EVM.iszero x

  | Ok x -> compile_expression env x @ [EVM.one]

  | Or [a; b] ->
    let a = compile_expression env a in
    let b = compile_expression env b in
    EVM.or' a b

  | Pow (a, b) ->
    let a = compile_expression env a in
    let b = compile_expression env b in
    EVM.exp a b  (* TODO: handle overflow *)

  | SomeExpression x -> compile_expression env x @ [EVM.one]

  | Sub [a; b] ->
    let a = compile_expression env a in
    let b = compile_expression env b in
    EVM.sub a b  (* TODO: handle underflow *)

  | Try input ->
    begin match type_of_expression input with
    | Optional _ ->
      let cond_value = compile_expression env input in
      let none_block = EVM.mstore_int 0 0 @ EVM.return1 in
      compile_branch cond_value [] none_block
    | Response _ ->
      let cond_value = compile_expression env input in
      let err_block = EVM.mstore_int 0 0 @ EVM.mstore 1 [] @ EVM.return2 in
      compile_branch cond_value [] err_block
    | t -> unsupported_function "try!" t
    end

  | UnwrapErr (input, thrown_value) ->
    begin match type_of_expression input with
    | Response _ ->
      let cond_value = compile_expression env input in
      let ok_block = EVM.pop1 @ compile_expression env thrown_value @ EVM.mstore 0 [] @ EVM.return1 in
      compile_branch cond_value ok_block []
    | t -> unsupported_function "unwrap-err!" t
    end

  | UnwrapErrPanic input ->
    begin match type_of_expression input with
    | Response _ ->
      let cond_value = compile_expression env input in
      let ok_block = EVM.pop1 @ EVM.revert0 in
      compile_branch cond_value ok_block []
    | t -> unsupported_function "unwrap-err-panic" t
    end

  | Unwrap (input, thrown_value) ->
    begin match type_of_expression input with
    | Optional _ ->
      let cond_value = compile_expression env input in
      let none_block = compile_expression env thrown_value @ EVM.mstore 0 [] @ EVM.return1 in
      compile_branch cond_value [] none_block
    | Response _ ->
      let cond_value = compile_expression env input in
      let err_block = EVM.pop1 @ compile_expression env thrown_value @ EVM.mstore 0 [] @ EVM.return1 in
      compile_branch cond_value [] err_block
    | t -> unsupported_function "unwrap!" t
    end

  | UnwrapPanic input ->
    begin match type_of_expression input with
    | Optional _ ->
      let cond_value = compile_expression env input in
      let none_block = EVM.revert0 in
      compile_branch cond_value [] none_block
    | Response _ ->
      let cond_value = compile_expression env input in
      let err_block = EVM.pop1 @ EVM.revert0 in
      compile_branch cond_value [] err_block
    | t -> unsupported_function "unwrap-panic" t
    end

  | VarGet var ->
    let var_slot = lookup_variable_slot env var in
    EVM.sload var_slot

  | VarSet (var, val') ->
    let var_slot = lookup_variable_slot env var in
    let val' = compile_expression env val' in
    EVM.sstore var_slot val'

  | Xor (a, b) ->
    let a = compile_expression env a in
    let b = compile_expression env b in
    EVM.xor a b

  | Keyword "block-height" -> EVM.number
  | Keyword "burn-block-height" -> EVM.number
  | Keyword "contract-caller" -> EVM.caller
  | Keyword "is-in-regtest" -> compile_literal (BoolLiteral false)
  | Keyword "stx-liquid-supply" -> unsupported "stx-liquid-supply"
  | Keyword "tx-sender" -> EVM.origin

  | FunctionCall ("append", [list; element]) ->
    begin match type_of_expression list, type_of_expression element with
    | List (n, e1), e2 when e1 = e2 ->
      let list = compile_expression env list in
      let element = compile_expression env element in
      list @ EVM.pop1 @ element @ [EVM.from_int (n + 1)]
    | t, e -> unsupported_function2 "append" t e
    end

  | FunctionCall ("asserts!", [bool_expr; _]) ->  (* TODO: thrown_value *)
    begin match type_of_expression bool_expr with
    | Bool ->
      let cond_value = compile_expression env bool_expr in
      let then_block = [EVM.one] in
      let else_block = EVM.revert0 in
      compile_branch cond_value then_block else_block
    | t -> unsupported_function "asserts!" t
    end

  | FunctionCall ("concat", [list1; list2]) ->
    begin match type_of_expression list1, type_of_expression list2 with
    | List (n1, e1), List (n2, e2) when e1 = e2 ->
      let list1 = compile_expression env list1 in
      let list2 = compile_expression env list2 in
      list1 @ EVM.pop1 @ list2 @ EVM.pop1 @ [EVM.from_int (n1 + n2)]
    | t1, t2 -> unsupported_function2 "concat" t1 t2
    end

  | FunctionCall ("get", [Identifier _; Identifier _]) ->  (* TODO *)
    [
      EVM.from_int 0x80;                 (* 128 bits *)
      EVM.two; EVM.EXP; EVM.MUL;         (* equivalent to EVM.SHL *)
      EVM.from_int 0x80;                 (* 128 bits *)
      EVM.two; EVM.EXP; EVM.SWAP 1; EVM.DIV;  (* equivalent to EVM.SWAP 1; EVM.SHR *)
    ]

  | FunctionCall ("hash160", [value]) ->
    begin match type_of_expression value with
    | Clarity.Buff _ | Int | Uint ->
      let input_size = size_of_expression value in
      let input_mstore = compile_mstore_of_expression env value in
      input_mstore @ EVM.staticcall_hash160 (0, input_size) 0 @ EVM.pop
    | t -> unsupported_function "hash160" t
    end

  | FunctionCall ("keccak256", [value]) ->
    begin match type_of_expression value with
    | Clarity.Buff _ | Int | Uint ->
      let input_size = size_of_expression value in
      let value = compile_expression env value in
      EVM.mstore 0 value @ EVM.sha3 (0, input_size)
    | t -> unsupported_function "keccak256" t
  end

  | FunctionCall ("map-set", [Identifier var; key; value]) ->  (* TODO *)
    let _ = lookup_variable_slot env var in
    let key = compile_expression env key in
    let value = compile_expression env value in
    value @ key @ [EVM.SSTORE]

  | FunctionCall ("map-get?", [Identifier var; TupleExpression [("key", _key)]]) ->  (* TODO *)
    let _ = lookup_variable_slot env var in
    let key = EVM.caller in  (* TODO *)
    key @ [EVM.SLOAD; EVM.DUP 1; EVM.ISZERO; EVM.NOT]

  | FunctionCall ("print", [expr]) ->
    begin match expr with
    | Literal value -> compile_static_print_call value
    | _ -> unimplemented "print for non-literals"  (* TODO *)
    end

  | FunctionCall ("sha256", [value]) ->
    begin match type_of_expression value with
    | Clarity.Buff _ | Int | Uint ->
      let input_size = size_of_expression value in
      let input_mstore = compile_mstore_of_expression env value in
      input_mstore @ EVM.staticcall_sha256 (0, input_size) 0 @ EVM.pop
    | t -> unsupported_function "sha256" t
  end

  | FunctionCall ("sha512", [value]) ->
    begin match type_of_expression value with
    | t -> unimplemented_function "sha512" t  (* TODO *)
    end

  | FunctionCall ("sha512/256", [value]) ->
    begin match type_of_expression value with
    | t -> unimplemented_function "sha512/256" t  (* TODO *)
    end

  | FunctionCall (name, _args) ->
    let block_id = lookup_function_block env name in
    let call_sequence =
      (* TODO: push function call arguments *)
      EVM.jump block_id
    in
    let call_length = EVM.opcodes_size call_sequence in
    (compile_relative_offset call_length) @ call_sequence @ EVM.jumpdest

  | _ -> unimplemented "arbitrary expressions"  (* TODO *)

and compile_static_print_call value =
  (* See: https://hardhat.org/hardhat-network/#console-log *)
  (* See: https://github.com/nomiclabs/hardhat/blob/master/packages/hardhat-core/console.sol *)
  let log_addr = "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x6F\x6e\x73\x6F\x6c\x65\x2e\x6c\x6f\x67" in
  let (signature, args) =
    match value with
    (* TODO: log(address) *)
    | NoneLiteral -> ("log()", [])
    | BoolLiteral b -> ("log(bool)", [EVM.ABI.BoolVal b])
    | IntLiteral z -> ("log(int)", [EVM.ABI.Int128Val z])
    | UintLiteral z -> ("log(uint)", [EVM.ABI.Uint128Val z])
    | BuffLiteral s ->
      let n = String.length s in
      if n > 0 && n <= 32 then (Printf.sprintf "log(bytes%d)" n, [EVM.ABI.Bytes32Val s])
      else ("log(bytes)", [EVM.ABI.BytesVal s])
    | StringLiteral s -> ("log(string)", [EVM.ABI.BytesVal s])
    | TupleLiteral _ -> unsupported_function "print" (type_of_literal value)
  in
  let payload = EVM.ABI.encode_with_signature signature args in
  let payload_size = String.length payload in
  let mstore = EVM.mstore_bytes 0 payload in
  [EVM.zero] @  (* TODO: the return value *)
  mstore @ EVM.staticcall log_addr (0, payload_size) (0, 0) @ EVM.pop

and compile_mstore_of_expression ?(offset=0) env expr =
  EVM.mstore offset (compile_expression env expr)

and compile_branch cond_block then_block else_block =
  let else_block = EVM.jumpdest @ else_block in
  let else_length = EVM.opcodes_size else_block in
  let then_block = then_block @ (compile_relative_jump else_length EVM.JUMP) in
  let then_length = EVM.opcodes_size then_block in
  cond_block @ [EVM.ISZERO] @ (compile_relative_jump then_length EVM.JUMPI) @
    then_block @ else_block @ EVM.jumpdest

and compile_relative_jump offset jump =
  let offset = 5 + offset in
  [EVM.PC; EVM.from_int offset; EVM.ADD; jump]

and compile_relative_offset offset =
  let offset = 4 + offset in
  [EVM.PC; EVM.from_int offset; EVM.ADD]

and compile_literal = function
  | NoneLiteral -> [EVM.zero]
  | BoolLiteral b -> [EVM.from_bool b]
  | IntLiteral z ->
    if (Big_int.num_bits_big_int z) <= 127 then [EVM.from_big_int z]
    else unsupported "int underflow/overflow"
  | UintLiteral z ->
    if (Big_int.num_bits_big_int z) <= 128 then [EVM.from_big_int z]
    else unsupported "uint overflow"
  | BuffLiteral s ->
    if (String.length s) <= 32 then [EVM.from_string s]
    else unimplemented "large buff literals (32+ bytes)"  (* TODO *)
  | StringLiteral s ->
    let len = String.length s in
    if len = 0 then [EVM.zero; EVM.zero]
    else if len <= 32 then [EVM.from_string s; EVM.from_int len]
    else unimplemented "large string literals (32+ bytes)"  (* TODO *)
  | TupleLiteral kvs -> compile_tuple_literal kvs

and compile_tuple_literal = function
  | [(_, (NoneLiteral as lit))]
  | [(_, (BoolLiteral _ as lit))]
  | [(_, (IntLiteral _ as lit))]
  | [(_, (UintLiteral _ as lit))] -> compile_literal lit
  | [(_, IntLiteral a); (_, IntLiteral b)] -> compile_packed_word a b
  | [(_, UintLiteral _a); (_, UintLiteral _b)] -> unimplemented "packed uint tuple literals"  (* TODO *)
  | _ -> unimplemented "arbitrary tuple literals"  (* TODO *)

and compile_packed_word hi lo =
  (* [EVM.from_big_int hi; EVM.from_int 0x80; EVM.SHL; EVM.from_big_int lo; EVM.OR] *)
  [EVM.from_big_int hi; EVM.from_int 0x80; EVM.two; EVM.EXP; EVM.MUL; EVM.from_big_int lo; EVM.OR]

and compile_param (_, type') =
  compile_type type'

and compile_type = function
  (* See: https://solidity.readthedocs.io/en/develop/abi-spec.html#types *)
  | Clarity.Principal -> EVM.ABI.Address
  | Bool -> Bool
  | Int -> Int128
  | Uint -> Uint128
  | Buff len | String (len, _) -> BytesN len
  | type' ->
    let type_name = Clarity.type_to_string type' in
    let error = Printf.sprintf "unsupported public parameter type: %s" type_name in
    failwith error

and mangle_name = function
  | "*" -> "mul"
  | "+" -> "add"
  | "-" -> "sub"
  | "/" -> "div"
  | "<" -> "lt"
  | "<=" -> "le"
  | ">" -> "gt"
  | ">=" -> "ge"
  | "sha512/256" -> "sha512_256"
  | "try!" -> "tryUnwrap"
  | name ->
    let filtered_chars = Str.regexp "[/?!]" in
    let name = Str.global_replace filtered_chars "" name in
    let words = String.split_on_char '-' name in
    let words = List.map String.capitalize_ascii words in
    String.uncapitalize_ascii (String.concat "" words)

and lookup_variable_slot env symbol =
  match lookup_symbol env.global_vars symbol with
  | None -> failwith (Printf.sprintf "unknown variable: %s" symbol)
  | Some index -> index

and lookup_function_block env symbol =
  match lookup_symbol env.global_funs symbol with
  | None -> failwith (Printf.sprintf "unknown function: %s" symbol)
  | Some index -> 1 + index

and lookup_symbol symbols symbol =
  let rec loop index = function
    | [] -> None
    | hd :: tl ->
      if hd = symbol then Some index
      else loop (index + 1) tl
  in
  loop 0 symbols

and link_offsets program =
  let rec loop pc = function
    | [] -> []
    | (_, body) :: rest ->
      let next_pc = pc + EVM.opcodes_size body in
      pc :: loop next_pc rest
  in
  loop 0 program

and link_program program =
  let block_offsets = link_offsets program in
  let rec link_block = function
    | [] -> []
    | EVM.PUSH (1, block_id) :: (EVM.JUMP as jump) :: rest
    | EVM.PUSH (1, block_id) :: (EVM.JUMPI as jump) :: rest ->
      let block_id = String.get block_id 0 |> Char.code in
      let block_pc = List.nth block_offsets block_id in
      EVM.from_int block_pc :: jump :: link_block rest
    | op :: rest -> op :: link_block rest
  in
  let rec link_blocks = function
    | [] -> []
    | (id, body) :: rest -> (id, link_block body) :: link_blocks rest
  in
  link_blocks program

and function_hash name params =
  let name = mangle_name name in
  let params = List.map compile_param params in
  EVM.ABI.encode_function_prototype name params

and size_of_expression expr =
  size_of_type (type_of_expression expr)

and size_of_type = function
  | Clarity.Unit -> 0
  | Principal -> 20
  | Bool | Int | Uint -> 16
  | Optional t -> size_of_type t
  | Response (t, _) -> size_of_type t
  | Buff n -> n
  | String (n, _) -> n
  | List _ -> unimplemented "size_of_type for lists"  (* TODO *)
  | Tuple _ -> unimplemented "size_of_type for tuples"  (* TODO *)


text:
(* This is free and unencumbered software released into the public domain. *)

#include "features.mli"
#include "utility.mli"
#include "typecheck.mli"
#include "compile.mli"


text:
(* This is free and unencumbered software released into the public domain. *)

val unreachable : unit -> unit

val unimplemented : string -> unit

val unsupported : string -> unit

val last : 'a list -> 'a option


text:
(* This is free and unencumbered software released into the public domain. *)

val decode : string -> program

val decode_opcodes : string -> opcode list

val decode_opcode : int -> opcode


text:
(* This is free and unencumbered software released into the public domain. *)

let rec encode_program program =
  let buffer = Buffer.create (program_size program) in
  encode_program_into_buffer buffer program;
  Buffer.contents buffer

and encode_program_into_buffer buffer program =
  List.iter (encode_block_into_buffer buffer) program

and encode_block block =
  let buffer = Buffer.create (block_size block) in
  encode_block_into_buffer buffer block;
  Buffer.contents buffer

and encode_block_into_buffer buffer (_, block_body) =
  encode_opcodes_into_buffer buffer block_body

and encode_operands = function
  | PUSH (_, s) -> s
  | _ -> ""

and encode_opcodes ops =
  let buffer = Buffer.create (List.length ops) in  (* TODO *)
  encode_opcodes_into_buffer buffer ops;
  Buffer.contents buffer

and encode_opcodes_into_buffer buffer ops =
  let rec encode_loop = function
  | [] -> ()
  | op :: ops -> begin
      let opcode = encode_opcode op |> Char.chr in
      let operands = encode_operands op in
      Buffer.add_char buffer opcode;
      Buffer.add_string buffer operands;
      encode_loop ops
    end
  in
  encode_loop ops

and encode_opcode = function
  | STOP -> 0x00
  | ADD -> 0x01
  | MUL -> 0x02
  | SUB -> 0x03
  | DIV -> 0x04
  | SDIV -> 0x05
  | MOD -> 0x06
  | SMOD -> 0x07
  | ADDMOD -> 0x08
  | MULMOD -> 0x09
  | EXP -> 0x0A
  | SIGNEXTEND -> 0x0B
  | LT -> 0x10
  | GT -> 0x11
  | SLT -> 0x12
  | SGT -> 0x13
  | EQ -> 0x14
  | ISZERO -> 0x15
  | AND -> 0x16
  | OR -> 0x17
  | XOR -> 0x18
  | NOT -> 0x19
  | BYTE -> 0x1A
  | SHL -> 0x1B
  | SHR -> 0x1C
  | SAR -> 0x1D
  | SHA3 -> 0x20
  | ADDRESS -> 0x30
  | BALANCE -> 0x31
  | ORIGIN -> 0x32
  | CALLER -> 0x33
  | CALLVALUE -> 0x34
  | CALLDATALOAD -> 0x35
  | CALLDATASIZE -> 0x36
  | CALLDATACOPY -> 0x37
  | CODESIZE -> 0x38
  | CODECOPY -> 0x39
  | GASPRICE -> 0x3A
  | EXTCODESIZE -> 0x3B
  | EXTCODECOPY -> 0x3C
  | RETURNDATASIZE -> 0x3D
  | RETURNDATACOPY -> 0x3E
  | EXTCODEHASH -> 0x3F
  | BLOCKHASH -> 0x40
  | COINBASE -> 0x41
  | TIMESTAMP -> 0x42
  | NUMBER -> 0x43
  | DIFFICULTY -> 0x44
  | GASLIMIT -> 0x45
  | POP -> 0x50
  | MLOAD -> 0x51
  | MSTORE -> 0x52
  | MSTORE8 -> 0x53
  | SLOAD -> 0x54
  | SSTORE -> 0x55
  | JUMP -> 0x56
  | JUMPI -> 0x57
  | PC -> 0x58
  | MSIZE -> 0x59
  | GAS -> 0x5A
  | JUMPDEST -> 0x5B
  | PUSH (0, _) -> unreachable ()
  | PUSH (n, _) -> 0x60 + n - 1
  | DUP n -> 0x80 + n - 1
  | SWAP n -> 0x90 + n - 1
  | LOG0 -> 0xA0
  | LOG1 -> 0xA1
  | LOG2 -> 0xA2
  | LOG3 -> 0xA3
  | LOG4 -> 0xA4
  | CREATE -> 0xF0
  | CALL -> 0xF1
  | CALLCODE -> 0xF2
  | RETURN -> 0xF3
  | DELEGATECALL -> 0xF4
  | CREATE2 -> 0xF5
  | STATICCALL -> 0xFA
  | REVERT -> 0xFD
  | INVALID -> 0xFE
  | SELFDESTRUCT -> 0xFF


text:
(* This is free and unencumbered software released into the public domain. *)

#include "utility.mli"
#include "opcodes.ml"
#include "abi.mli"
#include "construct.mli"
#include "metrics.mli"
#include "decode.mli"
#include "encode.mli"
#include "print.mli"
#include "debug.mli"


text:
(library
 (name EVM)
 (modules EVM)
 (wrapped false)
 (preprocess (action (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file})))
 (preprocessor_deps
  abi.ml
  abi.mli
  construct.ml
  construct.mli
  debug.ml
  debug.mli
  decode.ml
  decode.mli
  encode.ml
  encode.mli
  metrics.ml
  metrics.mli
  opcodes.ml
  print.ml
  print.mli
  utility.ml
  utility.mli)
 (libraries cryptokit num))


text:
(* This is free and unencumbered software released into the public domain. *)

#include "utility.ml"
#include "opcodes.ml"
#include "abi.ml"
#include "construct.ml"
#include "metrics.ml"
#include "decode.ml"
#include "encode.ml"
#include "print.ml"
#include "debug.ml"


text:
(* This is free and unencumbered software released into the public domain. *)

val program_size : program -> int

val block_size : block -> int

val opcodes_size : opcode list -> int

val opcode_size : opcode -> int


text:
(* This is free and unencumbered software released into the public domain. *)

let rec print_program_as_bytecode ppf program =
  List.iter (print_block_as_bytecode ppf) program

and print_program_as_opcode ppf program =
  List.iteri (print_block_as_opcode ppf) program

and print_block_as_bytecode ppf block =
  let bytecode = encode_block block in
  let print_byte b = Format.fprintf ppf "%02x@," @@ Char.code b in
  String.iter print_byte bytecode

and print_block_as_opcode ppf index = function
  | (_, []) -> ()
  | (_, block_body) ->
    if index > 0 then Format.pp_print_space ppf ();
    print_opcodes ppf block_body

and print_opcodes ppf ops =
  let open Format in
  pp_print_list ~pp_sep:pp_print_space print_opcode ppf ops

and print_opcode ppf op =
  Format.fprintf ppf "%s" @@ to_string op

and print_operand ppf s =
  Format.pp_print_string ppf "0x";
  String.iter (fun b -> Format.fprintf ppf "%02x" (Char.code b)) s

and to_string = function
  | STOP -> "STOP"
  | ADD -> "ADD"
  | MUL -> "MUL"
  | SUB -> "SUB"
  | DIV -> "DIV"
  | SDIV -> "SDIV"
  | MOD -> "MOD"
  | SMOD -> "SMOD"
  | ADDMOD -> "ADDMOD"
  | MULMOD -> "MULMOD"
  | EXP -> "EXP"
  | SIGNEXTEND -> "SIGNEXTEND"
  | LT -> "LT"
  | GT -> "GT"
  | SLT -> "SLT"
  | SGT -> "SGT"
  | EQ -> "EQ"
  | ISZERO -> "ISZERO"
  | AND -> "AND"
  | OR -> "OR"
  | XOR -> "XOR"
  | NOT -> "NOT"
  | BYTE -> "BYTE"
  | SHL -> "SHL"
  | SHR -> "SHR"
  | SAR -> "SAR"
  | SHA3 -> "SHA3"
  | ADDRESS -> "ADDRESS"
  | BALANCE -> "BALANCE"
  | ORIGIN -> "ORIGIN"
  | CALLER -> "CALLER"
  | CALLVALUE -> "CALLVALUE"
  | CALLDATALOAD -> "CALLDATALOAD"
  | CALLDATASIZE -> "CALLDATASIZE"
  | CALLDATACOPY -> "CALLDATACOPY"
  | CODESIZE -> "CODESIZE"
  | CODECOPY -> "CODECOPY"
  | GASPRICE -> "GASPRICE"
  | EXTCODESIZE -> "EXTCODESIZE"
  | EXTCODECOPY -> "EXTCODECOPY"
  | RETURNDATASIZE -> "RETURNDATASIZE"
  | RETURNDATACOPY -> "RETURNDATACOPY"
  | EXTCODEHASH -> "EXTCODEHASH"
  | BLOCKHASH -> "BLOCKHASH"
  | COINBASE -> "COINBASE"
  | TIMESTAMP -> "TIMESTAMP"
  | NUMBER -> "NUMBER"
  | DIFFICULTY -> "DIFFICULTY"
  | GASLIMIT -> "GASLIMIT"
  | POP -> "POP"
  | MLOAD -> "MLOAD"
  | MSTORE -> "MSTORE"
  | MSTORE8 -> "MSTORE8"
  | SLOAD -> "SLOAD"
  | SSTORE -> "SSTORE"
  | JUMP -> "JUMP"
  | JUMPI -> "JUMPI"
  | PC -> "PC"
  | MSIZE -> "MSIZE"
  | GAS -> "GAS"
  | JUMPDEST -> "JUMPDEST"
  | PUSH (n, s) -> begin
      let buffer = Buffer.create (2 * (String.length s)) in
      let ppf = Format.formatter_of_buffer buffer in
      print_operand ppf s;
      Format.pp_print_flush ppf ();
      Format.sprintf "PUSH%d %s" n (Buffer.contents buffer)
    end
  | DUP n -> Format.sprintf "DUP%d" n
  | SWAP n -> Format.sprintf "SWAP%d" n
  | LOG0 -> "LOG0"
  | LOG1 -> "LOG1"
  | LOG2 -> "LOG2"
  | LOG3 -> "LOG3"
  | LOG4 -> "LOG4"
  | CREATE -> "CREATE"
  | CALL -> "CALL"
  | CALLCODE -> "CALLCODE"
  | RETURN -> "RETURN"
  | DELEGATECALL -> "DELEGATECALL"
  | CREATE2 -> "CREATE2"
  | STATICCALL -> "STATICCALL"
  | REVERT -> "REVERT"
  | INVALID -> "INVALID"
  | SELFDESTRUCT -> "SELFDESTRUCT"


text:
(* This is free and unencumbered software released into the public domain. *)

let print_debug ppf program =
  let open Format in
  let jumpdest_to_block jumpdest_pc =
    let rec loop pc = function
      | [] -> None
      | block :: _ when pc = jumpdest_pc -> Some block
      | (_, block_body) :: blocks ->
        loop (pc + opcodes_size block_body) blocks
    in
    loop 0 program
  in
  let print_op pc = function
    | PUSH (1, byte_value) as op ->
      let decimal_value = Char.code (String.get byte_value 0) in
      fprintf ppf "%04x: %s (%d)\n" pc (to_string op) decimal_value
    (* TODO: | PUSH (n, _) *)
    | op -> fprintf ppf "%04x: %s\n" pc (to_string op)
  in
  let print_push_jumpdest pc op =
    match jumpdest_to_block pc with
    | None -> fprintf ppf "%04x: %s (?)\n" pc (to_string op)
    | Some (block_id, _) -> fprintf ppf "%04x: %s (#%d)\n" pc (to_string op) block_id
  in
  let rec dump_block pc = function
    | [] -> ()
    | (block_id, block_body) :: blocks ->
      let rec dump_opcode pc = function
        | [] -> pc
        | (PUSH (1, jumpdest) as op1) :: (JUMPI as op2) :: ops ->
          let jumpdest_pc = Char.code (String.get jumpdest 0) in
          print_push_jumpdest jumpdest_pc op1;
          let pc = pc + (opcode_size op1) in
          print_op pc op2;
          let pc = pc + (opcode_size op2) in
          dump_opcode pc ops
        (* TODO: | PUSH (n, _) *)
        | op :: ops ->
          print_op pc op;
          let pc = pc + (opcode_size op) in
          dump_opcode pc ops
      in
      fprintf ppf "#%d\n" block_id;
      let pc = dump_opcode pc block_body in
      dump_block pc blocks
  in
  dump_block 0 program


text:
(* This is free and unencumbered software released into the public domain. *)

type addr = string

type ptr = int

type slice = ptr * int

val addr_of_int : int -> addr

val ptr_of_int : int -> ptr

val zero : opcode

val one : opcode

val two : opcode

val from_big_int : Big_int.big_int -> opcode

val from_bool : bool -> opcode

val from_int : int -> opcode

val from_string : string -> opcode

val from_addr : addr -> opcode

val from_ptr : ptr -> opcode

val bytes32 : string -> opcode

val add : opcode list -> opcode list -> opcode list

val and' : opcode list -> opcode list -> opcode list

val caller : opcode list

val div : opcode list -> opcode list -> opcode list

val dup : int -> opcode list
val dup1 : opcode list

val eq : opcode list -> opcode list -> opcode list

val exp : opcode list -> opcode list -> opcode list

val ge : opcode list -> opcode list -> opcode list

val gt : opcode list -> opcode list -> opcode list

val iszero : opcode list -> opcode list

val jump : int -> opcode list

val jumpdest : opcode list

val le : opcode list -> opcode list -> opcode list

val lt : opcode list -> opcode list -> opcode list

val mload : ptr -> opcode list

val mod' : opcode list -> opcode list -> opcode list

val mstore : ptr -> opcode list -> opcode list
val mstore_int : ptr -> int -> opcode list
val mstore_bytes : ptr -> string -> opcode list

val mul : opcode list -> opcode list -> opcode list

val not' : opcode list -> opcode list

val number : opcode list

val or' : opcode list -> opcode list -> opcode list

val origin : opcode list

val pop : opcode list
val pop1 : opcode list
val pop2 : opcode list

val return' : slice -> opcode list
val return0 : opcode list
val return1 : opcode list
val return2 : opcode list

val revert : slice -> opcode list
val revert0 : opcode list
val revert1 : opcode list
val revert2 : opcode list

val sha3 : slice -> opcode list

val sload : int -> opcode list

val sstore : int -> opcode list -> opcode list

val staticcall : ?gas:int -> addr -> slice -> slice -> opcode list
val staticcall_hash160 : slice -> ptr -> opcode list
val staticcall_sha256 : slice -> ptr -> opcode list

val stop : opcode list

val sub : opcode list -> opcode list -> opcode list

val xor : opcode list -> opcode list -> opcode list


text:
(* This is free and unencumbered software released into the public domain. *)

module ABI = struct
  type type' =
    | Address
    | Bool
    | Bytes32
    | BytesN of int
    | Bytes
    | Int128
    | Int256
    | Uint128
    | Uint256

  type word =
    | AddressVal of string
    | BoolVal of bool
    | Bytes32Val of string
    | BytesNVal of int * string
    | BytesVal of string
    | IntVal of int
    | Int128Val of Big_int.big_int
    | Int256Val of Big_int.big_int
    | UintVal of int
    | Uint128Val of Big_int.big_int
    | Uint256Val of Big_int.big_int

  let type_of = function
    | AddressVal _ -> Address
    | BoolVal _ -> Bool
    | Bytes32Val _ -> Bytes32
    | BytesNVal (n, _) -> BytesN n
    | BytesVal _ -> Bytes
    | IntVal _ -> Int256
    | Int128Val _ -> Int128
    | Int256Val _ -> Int256
    | UintVal _ -> Uint256
    | Uint128Val _ -> Uint128
    | Uint256Val _ -> Uint256

  and type_to_string = function
    | Address -> "address"
    | Bool -> "bool"
    | Bytes32 -> "bytes32"
    | BytesN n -> Printf.sprintf "bytes%d" n
    | Bytes -> "bytes"
    | Int128 -> "int128"
    | Int256 -> "int256"
    | Uint128 -> "uint128"
    | Uint256 -> "uint256"

  let keccak256 input =
    let hash_function = Cryptokit.Hash.keccak 256 in
    Cryptokit.hash_string hash_function input

  let rec encode_with_signature signature args =
    let selector = encode_function_signature signature in
    encode_with_selector selector args

  and encode_with_selector selector args =
    let buffer = Buffer.create 32 in
    Buffer.add_string buffer selector;
    let append_arg arg = Buffer.add_string buffer (encode_parameter arg) in
    List.iter append_arg args;
    Buffer.contents buffer

  and encode_function_prototype name params =
    let params = String.concat "," (List.map type_to_string params) in
    let signature = Printf.sprintf "%s(%s)" name params in
    encode_function_signature signature

  and encode_function_signature signature =
    String.sub (keccak256 signature) 0 4

  and encode_parameter = function
    | AddressVal s -> encode_address_as_bytes32 s
    | BoolVal b -> encode_int_as_uint256 (if b then 1 else 0)
    | Bytes32Val s -> encode_string_as_bytes32 s
    | BytesNVal (_, s) -> encode_string_as_bytes32 s
    | BytesVal s -> encode_string_as_bytes s
    | IntVal z | UintVal z -> encode_int_as_uint256 z
    | Int128Val z | Uint128Val z -> encode_bigint_as_uint256 z
    | Int256Val z | Uint256Val z -> encode_bigint_as_uint256 z

  and encode_address_as_bytes32 address =
    begin match String.length address with
    | 20 ->
      let buffer = Buffer.create 32 in
      for _ = 1 to 12 do Buffer.add_char buffer '\x00' done;
      Buffer.add_string buffer address;
      Buffer.contents buffer
    | _ -> failwith "invalid address"
    end

  and encode_string_as_bytes32 input =
    begin match String.length input with
    | 32 -> input
    | length when length > 32 -> failwith "invalid inline string"
    | length ->
      let buffer = Buffer.create 32 in
      Buffer.add_string buffer input;
      for _ = length + 1 to 32 do Buffer.add_char buffer '\x00' done;
      Buffer.contents buffer
    end

  and encode_string_as_bytes input =
    let length = String.length input in
    let buffer = Buffer.create 64 in
    Buffer.add_int64_be buffer 0L;
    Buffer.add_int64_be buffer 0L;
    Buffer.add_int64_be buffer 0L;
    Buffer.add_int64_be buffer (Int64.of_int length);
    Buffer.add_string buffer input;
    for _ = length + 1 to 32 do Buffer.add_char buffer '\x00' done;
    Buffer.contents buffer

  and encode_int_as_uint256 z =
    encode_int64_as_uint256 (Int64.of_int z)

  and encode_int32_as_uint256 z =
    encode_int64_as_uint256 (Int64.of_int32 z)

  and encode_int64_as_uint256 z =
    let buffer = Buffer.create 32 in
    Buffer.add_int64_be buffer 0L;
    Buffer.add_int64_be buffer 0L;
    Buffer.add_int64_be buffer 0L;
    Buffer.add_int64_be buffer z;
    Buffer.contents buffer

  and encode_bigint_as_uint256 z =
    match Big_int.int64_of_big_int_opt z with
    | Some z -> encode_int64_as_uint256 z
    | None -> unimplemented ""  (* TODO *)
end


text:
(* This is free and unencumbered software released into the public domain. *)

val print_program_as_bytecode : Format.formatter -> program -> unit

val print_program_as_opcode : Format.formatter -> program -> unit

val print_opcodes : Format.formatter -> opcode list -> unit

val print_opcode : Format.formatter -> opcode -> unit

val to_string : opcode -> string


text:
(* This is free and unencumbered software released into the public domain. *)

type contract = program * program

and program = block list

and block = int * opcode list

and opcode =
  (* 0x00s: Stop & Arithmetic Operations *)
  | STOP
  | ADD
  | MUL
  | SUB
  | DIV
  | SDIV
  | MOD
  | SMOD
  | ADDMOD
  | MULMOD
  | EXP
  | SIGNEXTEND

  (* 0x10s: Comparison & Bitwise Logic Operations *)
  | LT
  | GT
  | SLT
  | SGT
  | EQ
  | ISZERO
  | AND
  | OR
  | XOR
  | NOT
  | BYTE
  | SHL  (* EIP-145 *)
  | SHR  (* EIP-145 *)
  | SAR  (* EIP-145 *)

  (* 0x20s: SHA3 *)
  | SHA3

  (* 0x30s: Environmental Information *)
  | ADDRESS
  | BALANCE
  | ORIGIN
  | CALLER
  | CALLVALUE
  | CALLDATALOAD
  | CALLDATASIZE
  | CALLDATACOPY
  | CODESIZE
  | CODECOPY
  | GASPRICE
  | EXTCODESIZE
  | EXTCODECOPY
  | RETURNDATASIZE  (* EIP-211 *)
  | RETURNDATACOPY  (* EIP-211 *)
  | EXTCODEHASH  (* EIP-1052 *)

  (* 0x40s: Block Information *)
  | BLOCKHASH
  | COINBASE
  | TIMESTAMP
  | NUMBER
  | DIFFICULTY
  | GASLIMIT

  (* 0x50s: Stack, Memory, Storage, and Flow Operations *)
  | POP
  | MLOAD
  | MSTORE
  | MSTORE8
  | SLOAD
  | SSTORE
  | JUMP
  | JUMPI
  | PC
  | MSIZE
  | GAS
  | JUMPDEST

  (* 0x60-70s: Push Operations *)
  | PUSH of int * string

  (* 0x80s: Duplication Operations *)
  | DUP of int

  (* 0x90s: Exchange Operations *)
  | SWAP of int

  (* 0xA0s: Logging Operations *)
  | LOG0
  | LOG1
  | LOG2
  | LOG3
  | LOG4

  (* 0xF0s: System Operations *)
  | CREATE
  | CALL
  | CALLCODE
  | RETURN
  | DELEGATECALL
  | CREATE2  (* EIP-1014 *)
  | STATICCALL  (* EIP-214 *)
  | REVERT  (* EIP-140 *)
  | INVALID  (* EIP-141 *)
  | SELFDESTRUCT


text:
(* This is free and unencumbered software released into the public domain. *)

type addr = string

type ptr = int

type slice = ptr * int

let rec addr_of_int z =
  match from_int z with PUSH (_, s) -> s | _ -> unreachable ()

and ptr_of_int z = z

and from_string = function
  | s when String.length s <= 32 -> PUSH (String.length s, s)
  | _ -> unimplemented ""  (* TODO *)

and from_big_int z =
  match Big_int.int_of_big_int_opt z with
  | Some z -> from_int z
  | None -> PUSH (32, ABI.encode_bigint_as_uint256 z)

and from_int z =
  if z < 0 then unimplemented "encoding of negative integers"  (* FIXME *)
  else if z <= 0xFF then PUSH (1, Char.chr z |> String.make 1)
  else PUSH (32, ABI.encode_int_as_uint256 z)

and from_bool b = from_int (if b then 1 else 0)

and from_ptr = function
  | ptr -> from_int ptr

and bytes32 s =
  match String.length s with
  | n when n = 32 -> PUSH (n, s)
  | n when n > 0 && n < 32 ->
    let buffer = Buffer.create 32 in
    Buffer.add_string buffer s;
    for _ = n + 1 to 32 do Buffer.add_char buffer '\x00' done;
    PUSH (32, Buffer.contents buffer)
  | _ -> unreachable ()

let from_addr = from_string

let zero = from_int 0

let one = from_int 1

let two = from_int 2

let add a b = b @ a @ [ADD]

let and' a b = b @ a @ [AND]

let caller = [CALLER]

let div a b = b @ a @ [DIV]

let dup n = [DUP n]

let dup1 = dup 1

let eq a b = b @ a @ [EQ]

let exp a b = b @ a @ [EXP]

let ge a b = b @ a @ [DUP 2; DUP 2; GT; SWAP 2; SWAP 1; EQ; OR]

let gt a b = b @ a @ [GT]

let iszero x = x @ [ISZERO]

let jump dest = [from_int dest; JUMP]

let jumpdest = [JUMPDEST]

let le a b = b @ a @ [DUP 2; DUP 2; LT; SWAP 2; SWAP 1; EQ; OR]

let lt a b = b @ a @ [LT]

let mload ptr = [from_ptr ptr; MLOAD]

let mod' a b = b @ a @ [MOD]

let mstore ptr val' = val' @ [from_ptr ptr; MSTORE]

let mstore_int ptr input = mstore ptr [from_int input]

let mstore_bytes ptr input =
  let input_size = String.length input in
  let rec loop ptr offset result =
    if offset >= input_size then result
    else begin
      let length = min (input_size - offset) 32 in
      let word = bytes32 (String.sub input offset length) in
      loop (ptr + 1) (offset + 32) ([word; from_ptr ptr; MSTORE] :: result)
    end
  in
  loop ptr 0 [] |> List.rev |> List.concat

let mul a b = b @ a @ [MUL]

let not' x = x @ [NOT]

let number = [NUMBER]

let or' a b = b @ a @ [OR]

let origin = [ORIGIN]

let pop = [POP]

let pop1 = pop
let pop2 = [POP; POP]

let return' = function
  | data_ptr, data_size when data_ptr = data_size -> [from_int data_size; DUP 1; RETURN]
  | data_ptr, data_size -> [from_int data_size; from_int data_ptr; RETURN]

let return0 = return' (0, 0)
let return1 = return' (0, 32)
let return2 = return' (0, 64)

let revert = function
  | data_ptr, data_size when data_ptr = data_size -> [from_int data_size; DUP 1; REVERT]
  | data_ptr, data_size -> [from_int data_size; from_int data_ptr; REVERT]

let revert0 = revert (0, 0)
let revert1 = revert (0, 32)
let revert2 = revert (0, 64)

let sha3 = function
  | input_ptr, input_size -> [from_int input_size; from_int input_ptr; SHA3]

let sload key = [from_int key; SLOAD]

let sstore key val' = val' @ [from_int key; SSTORE]

let staticcall ?(gas=0) addr (input_ptr, input_size) (output_ptr, output_size) =
  [
    from_int output_size;
    from_ptr output_ptr;
    from_int input_size;
    from_ptr input_ptr;
    from_addr addr;
    if gas > 0 then from_int gas else GAS;
    STATICCALL (* gas, addr, argsOffset, argsLength, retOffset, retLength *)
  ]

let staticcall_hash160 (input_ptr, input_size) output_ptr =
  staticcall (addr_of_int 0x03) (input_ptr, input_size) (output_ptr, 32)

let staticcall_sha256 (input_ptr, input_size) output_ptr =
  staticcall (addr_of_int 0x02) (input_ptr, input_size) (output_ptr, 32)

let stop = [STOP]

let sub a b = b @ a @ [SUB]

let xor a b = b @ a @ [XOR]


text:
(* This is free and unencumbered software released into the public domain. *)

let unreachable () = failwith "unreachable"

let unimplemented what =
  let message =
    if what = "" then "not implemented yet"
    else Printf.sprintf "%s not implemented yet" what
  in
  failwith message

let unsupported what =
  let message =
    if what = "" then "not supported"
    else Printf.sprintf "%s not supported" what
  in
  failwith message


text:
(* This is free and unencumbered software released into the public domain. *)

let rec program_size program =
  List.fold_left (fun sum block -> sum + block_size block) 0 program

and block_size (_, block) = opcodes_size block

and opcodes_size opcodes =
  List.fold_left (fun sum op -> sum + opcode_size op) 0 opcodes

and opcode_size = function
  | PUSH (n, _) -> 1 + n
  | _ -> 1


text:
(* This is free and unencumbered software released into the public domain. *)

val print_debug : Format.formatter -> program -> unit


text:
(* This is free and unencumbered software released into the public domain. *)

let rec decode input =
  let length = String.length input in
  let rec decode_loop index =
    if index = length then []
    else begin
      let byte = String.get input index |> Char.code in
      let (pc', op) = match decode_opcode byte with
      | PUSH (n, _) -> (1 + n, PUSH (n, (String.sub input (index + 1) n)))
      | op -> (1, op)
      in
      [op] @ decode_loop (index + pc')
    end
  in
  [(0, decode_loop 0)]  (* FIXME *)

and decode_opcodes input =
  match decode input with [(_, ops)] -> ops | _ -> []  (* FIXME *)

and decode_opcode = function
  | 0x00 -> STOP
  | 0x01 -> ADD
  | 0x02 -> MUL
  | 0x03 -> SUB
  | 0x04 -> DIV
  | 0x05 -> SDIV
  | 0x06 -> MOD
  | 0x07 -> SMOD
  | 0x08 -> ADDMOD
  | 0x09 -> MULMOD
  | 0x0A -> EXP
  | 0x0B -> SIGNEXTEND
  | 0x10 -> LT
  | 0x11 -> GT
  | 0x12 -> SLT
  | 0x13 -> SGT
  | 0x14 -> EQ
  | 0x15 -> ISZERO
  | 0x16 -> AND
  | 0x17 -> OR
  | 0x18 -> XOR
  | 0x19 -> NOT
  | 0x1A -> BYTE
  | 0x1B -> SHL
  | 0x1C -> SHR
  | 0x1D -> SAR
  | 0x20 -> SHA3
  | 0x30 -> ADDRESS
  | 0x31 -> BALANCE
  | 0x32 -> ORIGIN
  | 0x33 -> CALLER
  | 0x34 -> CALLVALUE
  | 0x35 -> CALLDATALOAD
  | 0x36 -> CALLDATASIZE
  | 0x37 -> CALLDATACOPY
  | 0x38 -> CODESIZE
  | 0x39 -> CODECOPY
  | 0x3A -> GASPRICE
  | 0x3B -> EXTCODESIZE
  | 0x3C -> EXTCODECOPY
  | 0x3D -> RETURNDATASIZE
  | 0x3E -> RETURNDATACOPY
  | 0x3F -> EXTCODEHASH
  | 0x40 -> BLOCKHASH
  | 0x41 -> COINBASE
  | 0x42 -> TIMESTAMP
  | 0x43 -> NUMBER
  | 0x44 -> DIFFICULTY
  | 0x45 -> GASLIMIT
  | 0x50 -> POP
  | 0x51 -> MLOAD
  | 0x52 -> MSTORE
  | 0x53 -> MSTORE8
  | 0x54 -> SLOAD
  | 0x55 -> SSTORE
  | 0x56 -> JUMP
  | 0x57 -> JUMPI
  | 0x58 -> PC
  | 0x59 -> MSIZE
  | 0x5A -> GAS
  | 0x5B -> JUMPDEST
  | 0x60 -> PUSH (1, "")
  | 0x61 -> PUSH (2, "")
  | 0x62 -> PUSH (3, "")
  | 0x63 -> PUSH (4, "")
  | 0x64 -> PUSH (5, "")
  | 0x65 -> PUSH (6, "")
  | 0x66 -> PUSH (7, "")
  | 0x67 -> PUSH (8, "")
  | 0x68 -> PUSH (9, "")
  | 0x69 -> PUSH (10, "")
  | 0x6A -> PUSH (11, "")
  | 0x6B -> PUSH (12, "")
  | 0x6C -> PUSH (13, "")
  | 0x6D -> PUSH (14, "")
  | 0x6E -> PUSH (15, "")
  | 0x6F -> PUSH (16, "")
  | 0x70 -> PUSH (17, "")
  | 0x71 -> PUSH (18, "")
  | 0x72 -> PUSH (19, "")
  | 0x73 -> PUSH (20, "")
  | 0x74 -> PUSH (21, "")
  | 0x75 -> PUSH (22, "")
  | 0x76 -> PUSH (23, "")
  | 0x77 -> PUSH (24, "")
  | 0x78 -> PUSH (25, "")
  | 0x79 -> PUSH (26, "")
  | 0x7A -> PUSH (27, "")
  | 0x7B -> PUSH (28, "")
  | 0x7C -> PUSH (29, "")
  | 0x7D -> PUSH (30, "")
  | 0x7E -> PUSH (31, "")
  | 0x7F -> PUSH (32, "")
  | 0x80 -> DUP 1
  | 0x81 -> DUP 2
  | 0x82 -> DUP 3
  | 0x83 -> DUP 4
  | 0x84 -> DUP 5
  | 0x85 -> DUP 6
  | 0x86 -> DUP 7
  | 0x87 -> DUP 8
  | 0x88 -> DUP 9
  | 0x89 -> DUP 10
  | 0x8A -> DUP 11
  | 0x8B -> DUP 12
  | 0x8C -> DUP 13
  | 0x8D -> DUP 14
  | 0x8E -> DUP 15
  | 0x8F -> DUP 16
  | 0x90 -> SWAP 1
  | 0x91 -> SWAP 2
  | 0x92 -> SWAP 3
  | 0x93 -> SWAP 4
  | 0x94 -> SWAP 5
  | 0x95 -> SWAP 6
  | 0x96 -> SWAP 7
  | 0x97 -> SWAP 8
  | 0x98 -> SWAP 9
  | 0x99 -> SWAP 10
  | 0x9A -> SWAP 11
  | 0x9B -> SWAP 12
  | 0x9C -> SWAP 13
  | 0x9D -> SWAP 14
  | 0x9E -> SWAP 15
  | 0x9F -> SWAP 16
  | 0xA0 -> LOG0
  | 0xA1 -> LOG1
  | 0xA2 -> LOG2
  | 0xA3 -> LOG3
  | 0xA4 -> LOG4
  | 0xF0 -> CREATE
  | 0xF1 -> CALL
  | 0xF2 -> CALLCODE
  | 0xF3 -> RETURN
  | 0xF4 -> DELEGATECALL
  | 0xF5 -> CREATE2
  | 0xFA -> STATICCALL
  | 0xFD -> REVERT
  | 0xFE -> INVALID
  | 0xFF -> SELFDESTRUCT
  | x -> failwith (Printf.sprintf "invalid opcode: 0x%x" x)


text:
(* This is free and unencumbered software released into the public domain. *)

val unreachable : unit -> unit

val unimplemented : string -> unit

val unsupported : string -> unit


text:
(* This is free and unencumbered software released into the public domain. *)

(* See: https://docs.soliditylang.org/en/develop/abi-spec.html *)
(* See: https://docs.soliditylang.org/en/develop/types.html *)
module ABI : sig
  type type' =
    | Address
    | Bool
    | Bytes32
    | BytesN of int
    | Bytes
    | Int128
    | Int256
    | Uint128
    | Uint256

  type word =
    | AddressVal of string
    | BoolVal of bool
    | Bytes32Val of string
    | BytesNVal of int * string
    | BytesVal of string
    | IntVal of int
    | Int128Val of Big_int.big_int
    | Int256Val of Big_int.big_int
    | UintVal of int
    | Uint128Val of Big_int.big_int
    | Uint256Val of Big_int.big_int

  val type_of : word -> type'
  val type_to_string : type' -> string

  val encode_with_signature : string -> word list -> string
  val encode_with_selector : string -> word list -> string
  val encode_function_prototype : string -> type' list -> string
  val encode_function_signature : string -> string
  val encode_parameter : word -> string
  val encode_address_as_bytes32 : string -> string
  val encode_string_as_bytes32 : string -> string
  val encode_int_as_uint256 : int -> string
  val encode_int32_as_uint256 : int32 -> string
  val encode_int64_as_uint256 : int64 -> string
  val encode_bigint_as_uint256 : Big_int.big_int -> string
end


text:
(* This is free and unencumbered software released into the public domain. *)

val encode_program : program -> string

val encode_program_into_buffer : Buffer.t -> program -> unit

val encode_block : block -> string

val encode_block_into_buffer : Buffer.t -> block -> unit

val encode_opcodes : opcode list -> string

val encode_opcodes_into_buffer : Buffer.t -> opcode list -> unit

val encode_opcode : opcode -> int


text:
(test
 (name test_hash)
 (modules test_hash)
 (preprocess (action (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file})))
 (libraries Clar2EVM alcotest))


text:
define-constant:

define-data-var:

define-fungible-token:

define-map:

define-non-fungible-token:

define-private:

define-public:

define-read-only:

define-trait: Not implemented yet.


text:
https://docs.blockstack.org/references/language-functions

+: For two parameters. Without overflow checking.

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (+ 6 7))
  > EOF
  PUSH1 0x07 PUSH1 0x06 ADD PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

-: For two parameters. Without underflow checking.

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (- 6 7))
  > EOF
  PUSH1 0x07 PUSH1 0x06 SUB PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

*: For two parameters. Without overflow checking.

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (* 6 7))
  > EOF
  PUSH1 0x07 PUSH1 0x06 MUL PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

/: For two parameters. Without division-by-zero checking.

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (/ 6 3))
  > EOF
  PUSH1 0x03 PUSH1 0x06 DIV PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

<:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (< 1 2))
  > EOF
  PUSH1 0x02 PUSH1 0x01 LT PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

<=:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (<= 1 2))
  > EOF
  PUSH1 0x02 PUSH1 0x01 DUP2 DUP2 LT SWAP2 SWAP1 EQ OR PUSH1 0x00 MSTORE
  PUSH1 0x20 PUSH1 0x00 RETURN STOP

>:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (> 1 2))
  > EOF
  PUSH1 0x02 PUSH1 0x01 GT PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

>=:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (>= 1 2))
  > EOF
  PUSH1 0x02 PUSH1 0x01 DUP2 DUP2 GT SWAP2 SWAP1 EQ OR PUSH1 0x00 MSTORE
  PUSH1 0x20 PUSH1 0x00 RETURN STOP

append:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (append (list 5 6 7) 8))
  > EOF
  PUSH1 0x05 PUSH1 0x06 PUSH1 0x07 PUSH1 0x03 POP PUSH1 0x08 PUSH1 0x04
  PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

asserts!:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (asserts! false (err 7)))
  > EOF
  PUSH1 0x00 ISZERO PC PUSH1 0x0c ADD JUMPI PUSH1 0x01 PC PUSH1 0x0a ADD JUMP
  JUMPDEST PUSH1 0x00 DUP1 REVERT JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20
  PUSH1 0x00 RETURN STOP

concat: Only for lists.

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (concat (list 5 6) (list 7 8)))
  > EOF
  PUSH1 0x05 PUSH1 0x06 PUSH1 0x02 POP PUSH1 0x07 PUSH1 0x08 PUSH1 0x02 POP
  PUSH1 0x04 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

default-to:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (default-to 7 none))
  > EOF
  PUSH1 0x00 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x08 ADD JUMP JUMPDEST
  PUSH1 0x07 JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (default-to 7 (some 9)))
  > EOF
  PUSH1 0x09 PUSH1 0x01 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x08 ADD JUMP
  JUMPDEST PUSH1 0x07 JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN
  STOP

err:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (err 5))
  > EOF
  PUSH1 0x05 PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (err u5))
  > EOF
  PUSH1 0x05 PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

filter:

fold:

ft-get-balance:

ft-mint?:

ft-transfer?:

hash160:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (hash160 0))
  > EOF
  PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 PUSH1 0x10 PUSH1 0x00
  PUSH1 0x03 GAS STATICCALL POP PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN
  STOP

is-eq: For two parameters.

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-eq true false))
  > EOF
  PUSH1 0x00 PUSH1 0x01 EQ PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-eq true true))
  > EOF
  PUSH1 0x01 PUSH1 0x01 EQ PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-eq 7 9))
  > EOF
  PUSH1 0x09 PUSH1 0x07 EQ PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-eq 9 9))
  > EOF
  PUSH1 0x09 PUSH1 0x09 EQ PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-eq u9 u9))
  > EOF
  PUSH1 0x09 PUSH1 0x09 EQ PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-eq 0xAB 0xAB))
  > EOF
  PUSH1 0xab PUSH1 0xab EQ PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-eq true 42))
  > EOF
  clarc: internal error, uncaught exception:
         Failure("(is-eq bool int) not supported")

  [125]

is-err:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-err (err u5)))
  > EOF
  PUSH1 0x05 PUSH1 0x00 ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN
  STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-err (ok true)))
  > EOF
  PUSH1 0x01 PUSH1 0x01 ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN
  STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-err 42))
  > EOF
  clarc: internal error, uncaught exception:
         Failure("(is-err int) not supported")

  [125]

is-none:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-none none))
  > EOF
  PUSH1 0x00 ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-none (some 5)))
  > EOF
  PUSH1 0x05 PUSH1 0x01 ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN
  STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-none 42))
  > EOF
  clarc: internal error, uncaught exception:
         Failure("(is-none int) not supported")

  [125]

is-ok:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-ok (err u5)))
  > EOF
  PUSH1 0x05 PUSH1 0x00 ISZERO ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00
  RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-ok (ok true)))
  > EOF
  PUSH1 0x01 PUSH1 0x01 ISZERO ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00
  RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-ok 42))
  > EOF
  clarc: internal error, uncaught exception:
         Failure("(is-ok int) not supported")

  [125]

is-some:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-some none))
  > EOF
  PUSH1 0x00 ISZERO ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-some (some 5)))
  > EOF
  PUSH1 0x05 PUSH1 0x01 ISZERO ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00
  RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (is-some 42))
  > EOF
  clarc: internal error, uncaught exception:
         Failure("(is-some int) not supported")

  [125]

keccak256:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (keccak256 0x01020304))
  > EOF
  PUSH4 0x01020304 PUSH1 0x00 MSTORE PUSH1 0x04 PUSH1 0x00 SHA3 PUSH1 0x00
  MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (keccak256 0))
  > EOF
  PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x10 PUSH1 0x00 SHA3 PUSH1 0x00 MSTORE
  PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (keccak256 (+ 1 2)))
  > EOF
  PUSH1 0x02 PUSH1 0x01 ADD PUSH1 0x00 MSTORE PUSH1 0x10 PUSH1 0x00 SHA3
  PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (keccak256 true))
  > EOF
  clarc: internal error, uncaught exception:
         Failure("(keccak256 bool) not supported")

  [125]

len: Only for literals.

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (len ""))
  > EOF
  PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (len "Hello, world!"))
  > EOF
  PUSH1 0x0d PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (len 0xDEADBEEF))
  > EOF
  PUSH1 0x04 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (len (list)))
  > EOF
  PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (len (list 1 2 3)))
  > EOF
  PUSH1 0x03 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

list:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (list))
  > EOF
  PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (list 7))
  > EOF
  PUSH1 0x07 PUSH1 0x01 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (list 1 2 3))
  > EOF
  PUSH1 0x01 PUSH1 0x02 PUSH1 0x03 PUSH1 0x03 PUSH1 0x00 MSTORE PUSH1 0x20
  PUSH1 0x00 RETURN STOP

map:

map-delete:

map-get?:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-map store ((key principal)) ((val int)))
  > (define-read-only (test)
  >   (map-get? store {key: tx-sender}))
  > EOF
  CALLER SLOAD DUP1 ISZERO NOT PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN
  STOP

map-insert:

map-set:

mod: Without division-by-zero checking.

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (mod 5 2))
  > EOF
  PUSH1 0x02 PUSH1 0x05 MOD PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

nft-get-owner?:

nft-mint?:

nft-transfer?:

not:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (not false))
  > EOF
  PUSH1 0x00 ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (not true))
  > EOF
  PUSH1 0x01 ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

ok:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (ok true))
  > EOF
  PUSH1 0x01 PUSH1 0x01 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (ok 5))
  > EOF
  PUSH1 0x05 PUSH1 0x01 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

pow: Without overflow checking.

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (pow 2 3))
  > EOF
  PUSH1 0x03 PUSH1 0x02 EXP PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

principal-of?:

print: Only for literals. Without a meaningful return value.

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (print 123))
  > EOF
  PUSH1 0x00
  PUSH32 0x4e0c1d1d00000000000000000000000000000000000000000000000000000000
  PUSH1 0x00 MSTORE
  PUSH32 0x0000007b00000000000000000000000000000000000000000000000000000000
  PUSH1 0x01 MSTORE PUSH1 0x00 PUSH1 0x00 PUSH1 0x24 PUSH1 0x00
  PUSH20 0x000000000000000000636f6e736f6c652e6c6f67 GAS STATICCALL POP
  PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (print "Hello, world!"))
  > EOF
  PUSH1 0x00
  PUSH32 0x41304fac00000000000000000000000000000000000000000000000000000000
  PUSH1 0x00 MSTORE
  PUSH32 0x0000000d48656c6c6f2c20776f726c6421000000000000000000000000000000
  PUSH1 0x01 MSTORE
  PUSH32 0x0000000000000000000000000000000000000000000000000000000000000000
  PUSH1 0x02 MSTORE PUSH1 0x00 PUSH1 0x00 PUSH1 0x44 PUSH1 0x00
  PUSH20 0x000000000000000000636f6e736f6c652e6c6f67 GAS STATICCALL POP
  PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

secp256k1-recover?: Not implemented yet.

secp256k1-verify: Not implemented yet.

sha256:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (sha256 0))
  > EOF
  PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 PUSH1 0x10 PUSH1 0x00
  PUSH1 0x02 GAS STATICCALL POP PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN
  STOP

sha512: Not implemented yet.

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (sha512 0))
  > EOF
  clarc: internal error, uncaught exception:
         Failure("(sha512 int) not implemented yet")

  [125]

sha512/256: Not implemented yet.

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (sha512/256 0))
  > EOF
  clarc: internal error, uncaught exception:
         Failure("(sha512/256 int) not implemented yet")

  [125]

some:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (some 5))
  > EOF
  PUSH1 0x05 PUSH1 0x01 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

sqrti: Not implemented yet.

stx-burn?: Not supported.

stx-get-balance: Not supported.

stx-transfer?: Not supported.

to-int:

to-uint:

try!:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (try! none))
  > EOF
  PUSH1 0x00 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x10 ADD JUMP JUMPDEST
  PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN JUMPDEST PUSH1 0x00
  MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (try! (some 7)))
  > EOF
  PUSH1 0x07 PUSH1 0x01 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x10 ADD JUMP
  JUMPDEST PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN JUMPDEST
  PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (try! (err 7)))
  > EOF
  PUSH1 0x07 PUSH1 0x00 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x13 ADD JUMP
  JUMPDEST PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x01 MSTORE PUSH1 0x40 PUSH1 0x00
  RETURN JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (try! (ok 7)))
  > EOF
  PUSH1 0x07 PUSH1 0x01 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x13 ADD JUMP
  JUMPDEST PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x01 MSTORE PUSH1 0x40 PUSH1 0x00
  RETURN JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

unwrap-err!:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (unwrap-err! (err 7) 9))
  > EOF
  PUSH1 0x07 PUSH1 0x00 ISZERO PC PUSH1 0x15 ADD JUMPI POP PUSH1 0x09
  PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN PC PUSH1 0x06 ADD JUMP
  JUMPDEST JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (unwrap-err! (ok 7) 9))
  > EOF
  PUSH1 0x07 PUSH1 0x01 ISZERO PC PUSH1 0x15 ADD JUMPI POP PUSH1 0x09
  PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN PC PUSH1 0x06 ADD JUMP
  JUMPDEST JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

unwrap-err-panic:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (unwrap-err-panic (err 7)))
  > EOF
  PUSH1 0x07 PUSH1 0x00 ISZERO PC PUSH1 0x0f ADD JUMPI POP PUSH1 0x00 DUP1
  REVERT PC PUSH1 0x06 ADD JUMP JUMPDEST JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20
  PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (unwrap-err-panic (ok 7)))
  > EOF
  PUSH1 0x07 PUSH1 0x01 ISZERO PC PUSH1 0x0f ADD JUMPI POP PUSH1 0x00 DUP1
  REVERT PC PUSH1 0x06 ADD JUMP JUMPDEST JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20
  PUSH1 0x00 RETURN STOP

unwrap!:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (unwrap! none 9))
  > EOF
  PUSH1 0x00 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x10 ADD JUMP JUMPDEST
  PUSH1 0x09 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN JUMPDEST PUSH1 0x00
  MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (unwrap! (some 7) 9))
  > EOF
  PUSH1 0x07 PUSH1 0x01 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x10 ADD JUMP
  JUMPDEST PUSH1 0x09 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN JUMPDEST
  PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (unwrap! (err 7) 9))
  > EOF
  PUSH1 0x07 PUSH1 0x00 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x11 ADD JUMP
  JUMPDEST POP PUSH1 0x09 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN
  JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (unwrap! (ok 7) 9))
  > EOF
  PUSH1 0x07 PUSH1 0x01 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x11 ADD JUMP
  JUMPDEST POP PUSH1 0x09 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN
  JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

unwrap-panic:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (unwrap-panic none))
  > EOF
  PUSH1 0x00 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x0a ADD JUMP JUMPDEST
  PUSH1 0x00 DUP1 REVERT JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00
  RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (unwrap-panic (some 7)))
  > EOF
  PUSH1 0x07 PUSH1 0x01 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x0a ADD JUMP
  JUMPDEST PUSH1 0x00 DUP1 REVERT JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20
  PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (unwrap-panic (err 7)))
  > EOF
  PUSH1 0x07 PUSH1 0x00 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x0b ADD JUMP
  JUMPDEST POP PUSH1 0x00 DUP1 REVERT JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20
  PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (unwrap-panic (ok 7)))
  > EOF
  PUSH1 0x07 PUSH1 0x01 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x0b ADD JUMP
  JUMPDEST POP PUSH1 0x00 DUP1 REVERT JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20
  PUSH1 0x00 RETURN STOP

xor:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (xor 1 2))
  > EOF
  PUSH1 0x02 PUSH1 0x01 XOR PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP


text:
https://docs.blockstack.org/references/language-types

none:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) none)
  > EOF
  PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

false:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) false)
  > EOF
  PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

true:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) true)
  > EOF
  PUSH1 0x01 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

int:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) 42)
  > EOF
  PUSH1 0x2a PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

uint:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) u42)
  > EOF
  PUSH1 0x2a PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

principal:

buff:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) 0x00)
  > EOF
  PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) 0x0000000000000000000000000000000000000000000000000000000000000000)
  > EOF
  PUSH32 0x0000000000000000000000000000000000000000000000000000000000000000
  PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) 0x0102)
  > EOF
  PUSH2 0x0102 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) 0x0102030405060708091011121314151617181920212223242526272829303132)
  > EOF
  PUSH32 0x0102030405060708091011121314151617181920212223242526272829303132
  PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

string:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) "")
  > EOF
  PUSH1 0x00 PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) "Hello, world!")
  > EOF
  PUSH13 0x48656c6c6f2c20776f726c6421 PUSH1 0x0d PUSH1 0x00 MSTORE PUSH1 0x20
  PUSH1 0x00 RETURN STOP

list:

tuple:


text:
https://docs.blockstack.org/references/language-keywords

block-height:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) block-height)
  > EOF
  NUMBER PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

burn-block-height:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) burn-block-height)
  > EOF
  NUMBER PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

contract-caller:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) contract-caller)
  > EOF
  CALLER PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

is-in-regtest:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) is-in-regtest)
  > EOF
  PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

stx-liquid-supply: Not supported.

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) stx-liquid-supply)
  > EOF
  clarc: internal error, uncaught exception:
         Failure("stx-liquid-supply not supported")

  [125]

tx-sender:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) tx-sender)
  > EOF
  ORIGIN PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP


text:
counter.clar:

  $ clarc -t opcode ../../../../../etc/examples/counter.clar
  PUSH1 0x00 PUSH1 0x00 SSTORE PUSH1 0x66 DUP1 PUSH1 0x10 PUSH1 0x00 CODECOPY
  PUSH1 0x00 RETURN PUSH1 0xe0 PUSH1 0x02 EXP PUSH1 0x00 CALLDATALOAD DIV DUP1
  PUSH4 0x8ada066e EQ PUSH1 0x28 JUMPI DUP1 PUSH4 0xd09de08a EQ PUSH1 0x38
  JUMPI DUP1 PUSH4 0x2baeceb7 EQ PUSH1 0x4f JUMPI STOP JUMPDEST POP PUSH1 0x00
  SLOAD PUSH1 0x01 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP JUMPDEST
  POP PUSH1 0x01 PUSH1 0x00 SLOAD ADD PUSH1 0x00 SSTORE PUSH1 0x00 SLOAD
  PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP JUMPDEST POP PUSH1 0x01
  PUSH1 0x00 SLOAD SUB PUSH1 0x00 SSTORE PUSH1 0x00 SLOAD PUSH1 0x00 MSTORE
  PUSH1 0x20 PUSH1 0x00 RETURN STOP

kv-store.clar:

  $ clarc -t opcode ../../../../../etc/examples/kv-store.clar
  PUSH1 0x00 PUSH1 0x00 SSTORE PUSH1 0x6a DUP1 PUSH1 0x10 PUSH1 0x00 CODECOPY
  PUSH1 0x00 RETURN PUSH1 0xe0 PUSH1 0x02 EXP PUSH1 0x00 CALLDATALOAD DIV DUP1
  PUSH4 0x3ccc0522 EQ PUSH1 0x1e JUMPI DUP1 PUSH4 0x6435c3e7 EQ PUSH1 0x50
  JUMPI STOP JUMPDEST POP CALLER SLOAD DUP1 ISZERO NOT ISZERO ISZERO PC
  PUSH1 0x0f ADD JUMPI POP PUSH1 0x00 PUSH1 0x00 PC PUSH1 0x15 ADD JUMP
  JUMPDEST PUSH1 0x80 PUSH1 0x02 EXP MUL PUSH1 0x80 PUSH1 0x02 EXP SWAP1 DIV
  PUSH1 0x01 JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP
  JUMPDEST POP PUSH1 0x64 PUSH1 0x80 PUSH1 0x02 EXP MUL PUSH1 0x07 OR ORIGIN
  SSTORE PUSH1 0x01 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

panic.clar:

  $ clarc -t opcode ../../../../../etc/examples/panic.clar
  PUSH1 0x00 PUSH1 0x00 SSTORE PUSH1 0x62 DUP1 PUSH1 0x10 PUSH1 0x00 CODECOPY
  PUSH1 0x00 RETURN PUSH1 0xe0 PUSH1 0x02 EXP PUSH1 0x00 CALLDATALOAD DIV DUP1
  PUSH4 0xc2187034 EQ PUSH1 0x3a JUMPI DUP1 PUSH4 0x4700d305 EQ PUSH1 0x4f
  JUMPI STOP JUMPDEST PUSH1 0x00 SLOAD DUP1 ISZERO ISZERO PC PUSH1 0x0f ADD
  JUMPI POP PUSH1 0x00 DUP1 REVERT PC PUSH1 0x07 ADD JUMP JUMPDEST SLOAD
  JUMPDEST SWAP1 JUMP STOP JUMPDEST POP PC PUSH1 0x07 ADD PUSH1 0x1e JUMP
  JUMPDEST PUSH1 0x01 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP
  JUMPDEST POP PC PUSH1 0x07 ADD PUSH1 0x1e JUMP JUMPDEST PUSH1 0x00 MSTORE
  PUSH1 0x20 PUSH1 0x00 RETURN STOP


text:
(* This is free and unencumbered software released into the public domain. *)

let keccak256 input =
  let hash_function = Cryptokit.Hash.keccak 256 in
  let hash = Cryptokit.hash_string hash_function input in
  String.sub hash 0 4

let keccak () =
  Alcotest.(check string) "" (keccak256 "abc") "\x4e\x03\x65\x7a";
  Alcotest.(check string) "" (keccak256 "getCounter()") "\x8a\xda\x06\x6e";
  Alcotest.(check string) "" (keccak256 "increment()") "\xd0\x9d\xe0\x8a";
  Alcotest.(check string) "" (keccak256 "decrement()") "\x2b\xae\xce\xb7"

let () =
  Alcotest.run "Clar2EVM" [
    "function_hash", [
      "keccak", `Quick, keccak;
    ];
  ]


text:
https://docs.blockstack.org/references/language-functions

and: For two parameters.

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (and true false))
  > EOF
  PUSH1 0x00 PUSH1 0x01 AND PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

as-contract:

as-max-len?:

at-block: Not implemented yet.

begin:

contract-call?: Not implemented yet.

contract-of: Not implemented yet.

get:

get-block-info?: Not implemented yet.

if:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (if true 5 7))
  > EOF
  PUSH1 0x01 ISZERO PC PUSH1 0x0c ADD JUMPI PUSH1 0x05 PC PUSH1 0x08 ADD JUMP
  JUMPDEST PUSH1 0x07 JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN
  STOP

impl-trait: Not implemented yet.

let:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (let ((x 7)) x))
  > EOF
  PUSH1 0x07 DUP1 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (let ((x 7) (y 9)) x))
  > EOF
  PUSH1 0x07 PUSH1 0x09 DUP2 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN
  STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (let ((x 7) (y 9)) y))
  > EOF
  PUSH1 0x07 PUSH1 0x09 DUP1 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN
  STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (let ((x 7)) (let ((x 9)) x)))
  > EOF
  PUSH1 0x07 PUSH1 0x09 DUP1 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN
  STOP

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (let ((x 7)) y))
  > EOF
  clarc: internal error, uncaught exception:
         Failure("unbound variable: y")

  [125]

match:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (match (some 3) x 5 7))
  > EOF
  PUSH1 0x03 PUSH1 0x01 ISZERO ISZERO PC PUSH1 0x0d ADD JUMPI POP PUSH1 0x07 PC
  PUSH1 0x08 ADD JUMP JUMPDEST PUSH1 0x05 JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20
  PUSH1 0x00 RETURN STOP

or: For two parameters.

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-read-only (test) (or true false))
  > EOF
  PUSH1 0x00 PUSH1 0x01 OR PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

tuple:

use-trait: Not implemented yet.

var-get:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-data-var counter int 0)
  > (define-read-only (test)
  >   (var-get counter))
  > EOF
  PUSH1 0x00 SLOAD PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP

var-set:

  $ clarc -t opcode -f only-function=test <<EOF
  > (define-data-var counter int 0)
  > (define-public (test)
  >  (begin
  >    (var-set counter 42)
  >    (ok true)))
  > EOF
  PUSH1 0x2a PUSH1 0x00 SSTORE PUSH1 0x01 PUSH1 0x00 MSTORE PUSH1 0x20
  PUSH1 0x00 RETURN STOP


text:
// SPDX-License-Identifier: Unlicense

pragma solidity ^0.7.0;

contract Panic {
  uint128 private trigger = 0;

  function panicPrivate() private view {
    // TODO
  }

  function panicReadOnly() public view {
    panicPrivate();
  }

  function panic() public {
    panicPrivate();
  }
}


text:
(define-data-var trigger (optional uint) none)

(define-private (panic-private)
  (unwrap-panic (var-get trigger))
)

(define-read-only (panic-read-only)
  (ok (panic-private))
)

(define-public (panic)
  (ok (panic-private))
)


text:
// SPDX-License-Identifier: Unlicense

pragma solidity ^0.7.0;

contract KvStore {
  mapping(address => int256) private store;

  function getValue(address key) public view returns (int128) {
    // TODO
    return 0;
  }

  function setValue(address key) public returns (bool) {
    // TODO
    return true;
  }
}


text:
// SPDX-License-Identifier: Unlicense

pragma solidity ^0.7.0;

contract Counter {
  int128 private count = 0;

  function getCounter() public view returns (int128) {
    return count;
  }

  function increment() public returns (int128) {
    count += 1;
    return count;
  }

  function decrement() public returns (int128) {
    count -= 1;
    return count;
  }
}


text:
(define-map store ((key principal))
  ((v1 int)
   (v2 int))
)

(define-public (get-value (key principal))
    (match (map-get? store {key: key})
        entry (ok (get v2 entry))
        (err 0)))

(define-public (set-value (key principal))
    (begin
        (map-set store {key: tx-sender} {v1: 100, v2: 7})
        (ok true)))


text:
(define-data-var counter int 0)

(define-read-only (get-counter)
  (ok (var-get counter)))

(define-public (increment)
  (begin
    (var-set counter (+ (var-get counter) 1))
    (ok (var-get counter))))

(define-public (decrement)
  (begin
    (var-set counter (- (var-get counter) 1))
    (ok (var-get counter))))


text:
UserParameter=basicCPUTemp.min,sensors | grep Core | awk -F'[:+°]' '{if(min==""){min=$3}; if($3<min) {min=$3};} END {print min}'
UserParameter=basicCPUTemp.max,sensors | grep Core | awk -F'[:+°]' '{if(max==""){max=$3}; if(max<$3) {max=$3};} END {print max}'
UserParameter=basicCPUTemp.avg,sensors | grep Core | awk -F'[:+°]' '{avg+=$3}END{print avg/NR}'


text:
<?xml version="1.0" encoding="UTF-8"?>
<zabbix_export>
    <version>3.4</version>
    <date>2017-10-24T11:37:07Z</date>
    <groups>
        <group>
            <name>Templates</name>
        </group>
    </groups>
    <templates>
        <template>
            <template>Template basicCPUTemp</template>
            <name>Template basicCPUTemp</name>
            <description/>
            <groups>
                <group>
                    <name>Templates</name>
                </group>
            </groups>
            <applications>
                <application>
                    <name>Temperature</name>
                </application>
            </applications>
            <items>
                <item>
                    <name>CPU Temperature Avg</name>
                    <type>0</type>
                    <snmp_community/>
                    <snmp_oid/>
                    <key>basicCPUTemp.avg</key>
                    <delay>10s</delay>
                    <history>90d</history>
                    <trends>365d</trends>
                    <status>0</status>
                    <value_type>0</value_type>
                    <allowed_hosts/>
                    <units>°C</units>
                    <snmpv3_contextname/>
                    <snmpv3_securityname/>
                    <snmpv3_securitylevel>0</snmpv3_securitylevel>
                    <snmpv3_authprotocol>0</snmpv3_authprotocol>
                    <snmpv3_authpassphrase/>
                    <snmpv3_privprotocol>0</snmpv3_privprotocol>
                    <snmpv3_privpassphrase/>
                    <params/>
                    <ipmi_sensor/>
                    <authtype>0</authtype>
                    <username/>
                    <password/>
                    <publickey/>
                    <privatekey/>
                    <port/>
                    <description/>
                    <inventory_link>0</inventory_link>
                    <applications>
                        <application>
                            <name>Temperature</name>
                        </application>
                    </applications>
                    <valuemap/>
                    <logtimefmt/>
                    <preprocessing/>
                    <jmx_endpoint/>
                    <master_item/>
                </item>
                <item>
                    <name>CPU Temperature Max</name>
                    <type>0</type>
                    <snmp_community/>
                    <snmp_oid/>
                    <key>basicCPUTemp.max</key>
                    <delay>10s</delay>
                    <history>90d</history>
                    <trends>365d</trends>
                    <status>0</status>
                    <value_type>0</value_type>
                    <allowed_hosts/>
                    <units>°C</units>
                    <snmpv3_contextname/>
                    <snmpv3_securityname/>
                    <snmpv3_securitylevel>0</snmpv3_securitylevel>
                    <snmpv3_authprotocol>0</snmpv3_authprotocol>
                    <snmpv3_authpassphrase/>
                    <snmpv3_privprotocol>0</snmpv3_privprotocol>
                    <snmpv3_privpassphrase/>
                    <params/>
                    <ipmi_sensor/>
                    <authtype>0</authtype>
                    <username/>
                    <password/>
                    <publickey/>
                    <privatekey/>
                    <port/>
                    <description/>
                    <inventory_link>0</inventory_link>
                    <applications>
                        <application>
                            <name>Temperature</name>
                        </application>
                    </applications>
                    <valuemap/>
                    <logtimefmt/>
                    <preprocessing/>
                    <jmx_endpoint/>
                    <master_item/>
                </item>
                <item>
                    <name>CPU Temperature Min</name>
                    <type>0</type>
                    <snmp_community/>
                    <snmp_oid/>
                    <key>basicCPUTemp.min</key>
                    <delay>10s</delay>
                    <history>90d</history>
                    <trends>365d</trends>
                    <status>0</status>
                    <value_type>0</value_type>
                    <allowed_hosts/>
                    <units>°C</units>
                    <snmpv3_contextname/>
                    <snmpv3_securityname/>
                    <snmpv3_securitylevel>0</snmpv3_securitylevel>
                    <snmpv3_authprotocol>0</snmpv3_authprotocol>
                    <snmpv3_authpassphrase/>
                    <snmpv3_privprotocol>0</snmpv3_privprotocol>
                    <snmpv3_privpassphrase/>
                    <params/>
                    <ipmi_sensor/>
                    <authtype>0</authtype>
                    <username/>
                    <password/>
                    <publickey/>
                    <privatekey/>
                    <port/>
                    <description/>
                    <inventory_link>0</inventory_link>
                    <applications>
                        <application>
                            <name>Temperature</name>
                        </application>
                    </applications>
                    <valuemap/>
                    <logtimefmt/>
                    <preprocessing/>
                    <jmx_endpoint/>
                    <master_item/>
                </item>
            </items>
            <discovery_rules/>
            <httptests/>
            <macros/>
            <templates/>
            <screens/>
        </template>
    </templates>
    <triggers>
        <trigger>
            <expression>{Template basicCPUTemp:basicCPUTemp.max.last()}>90.0</expression>
            <recovery_mode>1</recovery_mode>
            <recovery_expression>{Template basicCPUTemp:basicCPUTemp.max.avg(60s)}<75</recovery_expression>
            <name>Temperature high</name>
            <correlation_mode>0</correlation_mode>
            <correlation_tag/>
            <url/>
            <status>0</status>
            <priority>3</priority>
            <description/>
            <type>0</type>
            <manual_close>0</manual_close>
            <dependencies/>
            <tags/>
        </trigger>
        <trigger>
            <expression>{Template basicCPUTemp:basicCPUTemp.max.last()}>95</expression>
            <recovery_mode>2</recovery_mode>
            <recovery_expression/>
            <name>Temperature too high</name>
            <correlation_mode>0</correlation_mode>
            <correlation_tag/>
            <url/>
            <status>0</status>
            <priority>5</priority>
            <description/>
            <type>0</type>
            <manual_close>1</manual_close>
            <dependencies/>
            <tags/>
        </trigger>
    </triggers>
    <graphs>
        <graph>
            <name>CPU Temperature</name>
            <width>900</width>
            <height>200</height>
            <yaxismin>0.0000</yaxismin>
            <yaxismax>100.0000</yaxismax>
            <show_work_period>1</show_work_period>
            <show_triggers>1</show_triggers>
            <type>0</type>
            <show_legend>1</show_legend>
            <show_3d>0</show_3d>
            <percent_left>0.0000</percent_left>
            <percent_right>0.0000</percent_right>
            <ymin_type_1>0</ymin_type_1>
            <ymax_type_1>0</ymax_type_1>
            <ymin_item_1>0</ymin_item_1>
            <ymax_item_1>0</ymax_item_1>
            <graph_items>
                <graph_item>
                    <sortorder>0</sortorder>
                    <drawtype>2</drawtype>
                    <color>1A7C11</color>
                    <yaxisside>0</yaxisside>
                    <calc_fnc>7</calc_fnc>
                    <type>0</type>
                    <item>
                        <host>Template basicCPUTemp</host>
                        <key>basicCPUTemp.min</key>
                    </item>
                </graph_item>
                <graph_item>
                    <sortorder>1</sortorder>
                    <drawtype>2</drawtype>
                    <color>2774A4</color>
                    <yaxisside>0</yaxisside>
                    <calc_fnc>7</calc_fnc>
                    <type>0</type>
                    <item>
                        <host>Template basicCPUTemp</host>
                        <key>basicCPUTemp.avg</key>
                    </item>
                </graph_item>
                <graph_item>
                    <sortorder>2</sortorder>
                    <drawtype>2</drawtype>
                    <color>F63100</color>
                    <yaxisside>0</yaxisside>
                    <calc_fnc>7</calc_fnc>
                    <type>0</type>
                    <item>
                        <host>Template basicCPUTemp</host>
                        <key>basicCPUTemp.max</key>
                    </item>
                </graph_item>
            </graph_items>
        </graph>
    </graphs>
</zabbix_export>


text:
# Zabbix Basic CPU Temperature
This is a very basic template for Zabbix to monitor CPU temperature of Linux machines based on [this](https://myopsblog.wordpress.com/2016/06/06/cpu-temperature-monitoring-with-zabbix/) blogpost.

## How to Install

### Configure Zabbix Agent
1. Make sure lm-sensors is installed. If not use `sudo apt install lm-sensors` to install it.
2. Copy userparameter_cputemp.conf to /etc/zabbix/zabbix_agentd.d/.
3. Restart zabbix-agent using `sudo systemctl restart zabbix-agent`.

### Configure Zabbix web-panel
1. In Configuration>Templates click on Import.
2. Choose Template basicCPUTemp.xml and click on Import.
3. Check whether temperature data is sent to Zabbix web-panel in Monitoring>Latest Data.
4. Create Screens and monitor your servers!

## What to do in case of errors
~NEW: Sadly I am not actively using this little piece of software any longer.~ I am back at it again!

Please feel free to [create issues](https://github.com/B1T0/zabbix-basic-cpu-temperature/issues/new) and pull requests. I will review them from time to time.
- Also check [the blogpost](https://myopsblog.wordpress.com/2016/06/06/cpu-temperature-monitoring-with-zabbix/) this template is based on to get to know how this works.