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))

Generating simple expressions with additions and subtractions

Arguments should be stack from the last to the first, first argument should be on the top of the stack.

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

(defn emit-expr [expr]
  (cond
    (number? expr) (printf "PUSH nat %d ;\n" expr)
    (list? expr)   (do
                     (doall (->> expr
                                 rest
                                 reverse
                                 (map emit-expr)))
                     (emit-expr (first expr)))
    (symbol? expr) (let [name (name expr)]
                     (cond
                       (= name "+") (printf "ADD ;\n")
                       (= name "-") (printf "SUB ;\n")))))

(emit-expr expression)

Which yields

PUSH nat 1 ;
PUSH nat 13 ;
SUB ;
PUSH nat 8 ;
SUB ;
PUSH nat 7 ;
PUSH nat 5 ;
ADD ;
PUSH nat 3 ;
ADD ;

Emitter state

I can't sanely have pure functions emitting code, so I'll have to have some state. Could have a better code also, using a IR using vectors and keywords as representations. It could help generating the necessary indentation later. It's important also to keep monitoring the stack size, after evaluating the whole expression, depending on the expression type the stack should have a specific size or be modified by some number, type derivations also depend on the stack.

(ns test)

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

(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-expr [expr state]
  (cond
    (number? expr) (emit-instr! state [:push :nat expr] 1)
    (list? expr)   (do
                     (emit-args state (rest expr))
                     (emit-expr (first expr) state))
    (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))

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