athos

(ns apply-ctor
  (import [java.lang.reflect Constructor]))

(defn- acceptable-types? [ptypes atypes]
  (and (= (count ptypes) (count atypes))
       (every? (fn [[ptype atype]]
                 (or (= ptype atype)
                     ((ancestors atype) ptype)))
               (map vector ptypes atypes))))

athos

(ns analyze)

(defmulti expr->clj-obj class)

(defmethod expr->clj-obj :default [x] x)

(defn exprs->clj-obj [xs]
  (vec (map expr->clj-obj xs)))

(def EVAL        clojure.lang.Compiler$C/EVAL)

athos

(import '[clojure.asm Opcodes Type ClassWriter]
        '[clojure.asm.commons Method GeneratorAdapter])

(defn make-class [name]
  (let [cw (ClassWriter. ClassWriter/COMPUTE_FRAMES)
        init (Method/getMethod "void <init>()")
        meth (Method/getMethod "int fact(int)")]
    (.visit cw Opcodes/V1_6 Opcodes/ACC_PUBLIC (.replace name \. \/) nil "java/lang/Object" nil)
    (doto (GeneratorAdapter. Opcodes/ACC_PUBLIC init nil nil cw)
      (.visitCode)

athos

sig Digit {}
one sig One, Two, Three, Four extends Digit {}

sig Cell {content: one One + Two + Three + Four}

sig Group {
  cells: set Cell
} {
  no disj c, c': cells | c.content = c'.content
}

athos

abstract sig Digit {}
one sig One, Two, Three, Four, Five, Six, Seven, Eight, Nine extends Digit {}

sig Cell {content: Digit}

abstract sig Group {
  cells: set Cell
} {
  no disj c, c': cells | c.content = c'.content
}

athos

open util/ordering [Array]

sig Num {}
sig Array {
  at: Num -> one Num
}

pred update(a, a': Array, i, v: Num) {
  a'.at = a.at ++ i -> v
}

athos

(defn defn-reader [body]
  (let [name (symbol (name (first (keys (dissoc (meta body) :tag)))))
        args (read-string (:tag (meta body)))]
    `(defn ~name ~args ~(seq body))))

(.bindRoot #'default-data-readers {'defn #'defn-reader})

#defn ^:fact ^"[x]"
[
  if (= x 0)

athos

(ns letrec
  ;; add [org.clojure/tools.macro "0.1.1"] to :dependencies if you use Leiningen,
  ;; or download it from https://github.com/clojure/tools.macro
  (:use [clojure.tools.macro :only [macrolet]]))

(defmacro letrec [bindings & body]
  (let [fnames (map first bindings)
        fname->label (zipmap fnames (range))
        fsym (gensym)
        max-nargs (reduce #(max %1 (count %2)) 0 (map second bindings))

athos

(use 'syntactic-closure.core)

(define-syntax aif
  (sc-macro-transformer
    (fn [[_ test then else] env]
      (quasiquote
        (let [it ~(make-syntactic-closure env nil test)]
          (if it
            ~(make-syntactic-closure env '[it] then)
            ~(make-syntactic-closure env nil else)))))))

athos

;; A solution for SRFI-72's "improved hygiene" using syntactic closures.
;; See also http://srfi.schemers.org/srfi-72/srfi-72.html#hygiene

(let-syntax ([main (sc-macro-transformer
                     (lambda (form env)
                       (define (make-swap x y)
                         `(let ([t ,x])
                            (set! ,x ,y)
                            (set! ,y t)))
                       `(let ([s 1] [t 2])