Skip to content

Instantly share code, notes, and snippets.

Avatar
🤷‍♂️
I know the value and cost of nothing

Ohta Shogo athos

🤷‍♂️
I know the value and cost of nothing
View GitHub Profile
View apply_ctor.clj
(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))))
View analyze.clj
(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
athos / gist:1033052
Created Jun 18, 2011
An example code to generate a class with ASM in Clojure.
View gist:1033052
(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
athos / gist:1817230
Created Feb 13, 2012
Sudoku(4x4) solver in Alloy
View gist:1817230
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
athos / gist:1826678
Created Feb 14, 2012
Sudoku(9x9) solver in Alloy
View gist:1826678
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
athos / gist:1924255
Created Feb 27, 2012
https://twitter.com/#!/wtakuo/status/173781581570387968 の解法を探るために使ったAlloyコード
View gist:1924255
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
athos / gist:2398796
Created Apr 16, 2012
an example of Clojure 1.4 reader literals
View gist:2398796
(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
athos / letrec.clj
Created Jul 8, 2012
optimizing mutual tail recursion without trampoline
View letrec.clj
(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))
View gist:3227434
(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
athos / gist:3295528
Created Aug 8, 2012
a solution for SRFI-72's "Improved hygiene" using syntactic closures
View gist:3295528
;; 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])
You can’t perform that action at this time.