Clojure for Tezos

Note.md

Clojure for Tezos

• Endpoints are declared by adding an :entrypoint metadata at the function declaration, which could further extended to a defentrypoint macro.
• Due to the typed nature of Michelson, the code must be typed to properly be translated to code:
  • Type declarations should use the type function (or macro?) to declare types for namespace defined variables.
  • Extra type annotation could be done by using metadata.
  • Need for a type checker, which I don't know how to implement (I don't know to how to build a backend also, but don't tell anyone).
  • Michelson types need a correspondence for Clojure literals, while some are possible, conjunction and disjunction types are not available for Clojure.
• Some types have an extra challenge, like option and or, because Clojure doesn't have the proper idioms to deal with it, I should define a few patterns to describe how to interpret them, mainly option.
• To descrease the overhead for type inference, some literals are going to be used for naturals and mutez, like 1n and 1mutez.

Just like domain specific stuff are exposed on the Tezos module for LIGO, I'm going to expose those on the tezos namespace.

Advantages

• Macros
• Emulate some of the dynamic features of Clojure and other Lisps

Examples

Counter contract

(type storage nat)
(type return (pair (list operation) storage))

(type increment (-> unit storage return))
(defn ^:entrypoint increment
  [_ storage]
  (tezos/pair :unit (inc storage))

(type decrement (-> unit storage return))
(defn ^:entrypoint decrement
  [_ storage]
  (tezos/pair :unit (dec storage)))
 
(type decrement (-> unit storage return))
(defn ^:entrypoint reset
  [_ _]
  (tezos/pair :unit 0))

Correctly emit binary and unary expressions

Most Michelson instructions accept two, one or no argument; which needs to be handle differently on Lisps that accepts left associative binary operations as n-ary like. Also correctly handle cases like (- <value>) emitting PUSH nat <value> ; NEG ;.

(ns test)

(def expression
  '(+ 3 (+ 5 7) (- 8 (- 13 1)) (- 4)))

(def is-binary-op? #{'+ '-})

(def is-unary-op? #{'+ '-})

(declare emit-expr)

(defn emit-instr [state instr stack]
  (assoc state
         :code  (conj (:code state) instr)
         :stack (+ (:stack state) stack)))

(defn emit-instr! [state instr stack]
  (swap! state emit-instr instr stack))

(defn emit-args [state args]
  (when (seq args)
    (emit-args state (rest args))
    (emit-expr (first args) state)))

(defn emit-binary-operation [state function args]
  (if (< (count args) 2)
    (throw (Exception. (str (name function) " is a binary operation"))))

  (let [[a1 a2 & rest] args]
    (emit-expr a2 state)
    (emit-expr a1 state)
    (emit-expr function state)

    (doseq [arg rest]
      (emit-expr arg state)
      (emit-expr function state))))

(defn emit-unary-operation [state operation arg]
  (emit-expr arg state)
  (cond
    (= operation '+) (emit-instr! state [:abs] 0)
    (= operation '-) (emit-instr! state [:neg] 0)
    :default         (emit-expr operation state)))

(defn emit-nary-operation [state function args]
  (emit-args state args)
  (emit-expr function state))

(defn emit-expr [expr state]
  (cond
    (number? expr) (emit-instr! state [:push :nat expr] 1)
    (list? expr)   (let [function (first expr)]
                     (cond
                       (and (is-unary-op? function)
                            (= 1 (count (rest expr)))) (emit-unary-operation state
                                                                             function
                                                                             (second expr))
                       (is-binary-op? function)        (emit-binary-operation state
                                                                              function
                                                                              (rest expr))
                       :default                        (emit-nary-operation state
                                                                            function
                                                                            (rest expr))))
    (symbol? expr) (cond
                     (= expr '+) (emit-instr! state [:add] -1)
                     (= expr '-) (emit-instr! state [:sub] -1))))


(def state
  (atom {:stack 0
         :code  []}))

(defn -main []
  (emit-expr expression state)
  (prn @state))

Symbols and repetitions

One of the problems I've encountered is that I can't have random access to memory, so accessing symbols becomes difficult because I need to duplicate and reorder things on the stack so the operations are valid. I still have no clear mental model of doing this and I've come to a simple way but without not proofs that it actually works.

1. Build the AST
2. Create a DAG from the AST
3. Sort the items of the DAG based on the order they would be on the stack
4. Duplicate the nodes of the symbols removing nodes with order greater than one and adding the distance between the top of the stack and the symbol (0 for a0)
5. Push the items (they should be already) and create the number of duplicates needed, when reorder is needed use the distance from the stop of the stack to know how many items you'll have to swap (you can use the DUG instruction if that's larger than a 1)

The on the right is wrong, it should be actually:

PUSH a ;
DUP ;
PUSH 3 ;
MUL ;
SWAP ;
PUSH 2 ;
SWAP ;
SUB ;
ADD ;

Another example

Some references I've found that may be helpful

• http://www.complang.tuwien.ac.at/anton/euroforth/ef00/bailey00.pdf
• http://www.complang.tuwien.ac.at/anton/euroforth2006/papers/shannon.pdf
• https://users.ece.cmu.edu/~koopman/stack_compiler/stack_co.pdf
• https://dl.acm.org/doi/pdf/10.1145/321892.321901
• https://ieeexplore.ieee.org/document/1646483