import tables
import types
type
MacroFn* = proc(args: seq[CljVal]): CljVal
var macroTable* = initTable[string, MacroFn]()
proc defineMacro*(name: string, fn: MacroFn) =
macroTable[name] = fn
proc isMacro*(name: string): bool =
macroTable.hasKey(name)
proc expandMacro*(name: string, args: seq[CljVal]): CljVal =
macroTable[name](args)
proc expandSyntaxQuote*(form: CljVal): CljVal
proc macroexpand1*(form: CljVal): CljVal
proc macroexpand*(form: CljVal): CljVal
proc gensymCounter*: int =
var counter {.global.} = 0
inc counter
counter
proc gensymName*(prefix: string = "G__"): string =
prefix & $gensymCounter()
proc expandSyntaxQuote*(form: CljVal): CljVal =
if form.isNil: return cljNil()
case form.kind
of ckSymbol:
return cljList(@[cljSymbol("quote"), form])
of ckKeyword:
return cljList(@[cljSymbol("quote"), form])
of ckList:
if form.items.len == 0:
return cljList(@[cljSymbol("quote"), cljList(@[])])
let head = form.items[0]
if head.kind == ckSymbol:
if head.symName == "unquote":
if form.items.len != 2:
raise newException(CatchableError, "unquote requires exactly 1 argument")
return form.items[1]
if head.symName == "unquote-splicing":
raise newException(CatchableError, "unquote-splicing can only be used inside a collection")
# Process each element
var parts: seq[CljVal] = @[]
for item in form.items:
parts.add(expandSyntaxQuote(item))
return cljList(@[cljSymbol("concat")] & parts)
of ckVector:
var parts: seq[CljVal] = @[]
for item in form.items:
parts.add(expandSyntaxQuote(item))
return cljList(@[cljSymbol("apply"), cljSymbol("vector"), cljList(@[cljSymbol("concat")] & parts)])
of ckMap:
var parts: seq[CljVal] = @[]
for i in 0..
0:
let bareName = name[slashPos+1..^1]
if isMacro(bareName):
return expandMacro(bareName, form.items[1..^1])
return form
proc macroexpand*(form: CljVal): CljVal =
result = form
while true:
let expanded = macroexpand1(result)
if expanded == result:
return result
result = expanded
# ---- Built-in macro implementations ----
proc threadingMacro(args: seq[CljVal], reverse: bool): CljVal =
if args.len < 2:
raise newException(CatchableError, "Threading macro requires at least 2 arguments")
var acc = args[0]
for i in 1.. 0:
if reverse:
acc = cljList(form.items & @[acc])
else:
acc = cljList(@[form.items[0], acc] & form.items[1..^1])
elif form.kind == ckSymbol:
acc = cljList(@[form, acc])
else:
raise newException(CatchableError, "Threading macro requires lists or symbols")
return acc
proc initMacros*() =
# fn* macro
defineMacro("fn*", proc(args: seq[CljVal]): CljVal =
if args.len < 2:
raise newException(CatchableError, "fn* requires params and body")
cljList(@[cljSymbol("fn")] & args)
)
# -> (thread-first)
defineMacro("->", proc(args: seq[CljVal]): CljVal =
threadingMacro(args, false)
)
# ->> (thread-last)
defineMacro("->>", proc(args: seq[CljVal]): CljVal =
threadingMacro(args, true)
)
# and
defineMacro("and", proc(args: seq[CljVal]): CljVal =
if args.len == 0: return cljBool(true)
if args.len == 1: return args[0]
var result = cljList(@[cljSymbol("if"), args[^1],
args[^1],
cljBool(false)])
for i in countdown(args.len - 2, 0):
result = cljList(@[cljSymbol("if"), args[i], result, cljBool(false)])
return result
)
# or
defineMacro("or", proc(args: seq[CljVal]): CljVal =
if args.len == 0: return cljNil()
if args.len == 1: return args[0]
var result = args[^1]
for i in countdown(args.len - 2, 0):
let gs = cljSymbol(gensymName("or_"))
result = cljList(@[cljSymbol("let"), cljVector(@[gs, args[i]]),
cljList(@[cljSymbol("if"), gs, gs, result])])
return result
)
# when-let
defineMacro("when-let", proc(args: seq[CljVal]): CljVal =
if args.len < 2:
raise newException(CatchableError, "when-let requires binding vector and body")
let binding = args[0]
let body = args[1..^1]
if binding.kind != ckVector or binding.items.len != 2:
raise newException(CatchableError, "when-let requires [name val]")
let name = binding.items[0]
let val = binding.items[1]
let gs = cljSymbol(gensymName("wl_"))
cljList(@[cljSymbol("let"), cljVector(@[gs, val]),
cljList(@[cljSymbol("when"), gs,
cljList(@[cljSymbol("let"), cljVector(@[name, gs])] & body)])])
)
# if-let
defineMacro("if-let", proc(args: seq[CljVal]): CljVal =
if args.len < 3:
raise newException(CatchableError, "if-let requires binding vector, then, and else")
let binding = args[0]
let thenBranch = args[1]
let elseBranch = args[2]
if binding.kind != ckVector or binding.items.len != 2:
raise newException(CatchableError, "if-let requires [name val]")
let name = binding.items[0]
let val = binding.items[1]
let gs = cljSymbol(gensymName("il_"))
cljList(@[cljSymbol("let"), cljVector(@[gs, val]),
cljList(@[cljSymbol("if"), gs,
cljList(@[cljSymbol("let"), cljVector(@[name, gs]), thenBranch]),
elseBranch])])
)
# when
defineMacro("when", proc(args: seq[CljVal]): CljVal =
if args.len < 1:
raise newException(CatchableError, "when requires condition and body")
let cond = args[0]
let body = args[1..^1]
cljList(@[cljSymbol("if"), cond,
cljList(@[cljSymbol("do")] & body),
cljNil()])
)
# when-not
defineMacro("when-not", proc(args: seq[CljVal]): CljVal =
if args.len < 1:
raise newException(CatchableError, "when-not requires condition and body")
let cond = args[0]
let body = args[1..^1]
cljList(@[cljSymbol("if"), cond, cljNil(),
cljList(@[cljSymbol("do")] & body)])
)
# cond
defineMacro("cond", proc(args: seq[CljVal]): CljVal =
if args.len == 0: return cljNil()
if args.len mod 2 != 0:
raise newException(CatchableError, "cond requires pairs of test/expr")
var result = cljNil()
for i in countdown((args.len div 2) - 1, 0):
let test = args[i * 2]
let expr = args[i * 2 + 1]
if test.kind == ckKeyword and test.kwName == "else":
result = expr
else:
result = cljList(@[cljSymbol("if"), test, expr, result])
return result
)
# cond->
defineMacro("cond->", proc(args: seq[CljVal]): CljVal =
if args.len < 1:
raise newException(CatchableError, "cond-> requires initial value and clauses")
let init = args[0]
let clauses = args[1..^1]
if clauses.len mod 2 != 0:
raise newException(CatchableError, "cond-> requires pairs of test/expr")
var result = init
for i in 0..<(clauses.len div 2):
let test = clauses[i * 2]
let expr = clauses[i * 2 + 1]
let gs = cljSymbol(gensymName("ct_"))
if expr.kind == ckList and expr.items.len > 0:
result = cljList(@[cljSymbol("let"), cljVector(@[gs, result]),
cljList(@[cljSymbol("if"), test,
cljList(@[expr.items[0], gs] & expr.items[1..^1]),
gs])])
else:
result = cljList(@[cljSymbol("let"), cljVector(@[gs, result]),
cljList(@[cljSymbol("if"), test,
cljList(@[expr, gs]),
gs])])
return result
)
# cond->>
defineMacro("cond->>", proc(args: seq[CljVal]): CljVal =
if args.len < 1:
raise newException(CatchableError, "cond->> requires initial value and clauses")
let init = args[0]
let clauses = args[1..^1]
if clauses.len mod 2 != 0:
raise newException(CatchableError, "cond->> requires pairs of test/expr")
var result = init
for i in 0..<(clauses.len div 2):
let test = clauses[i * 2]
let expr = clauses[i * 2 + 1]
let gs = cljSymbol(gensymName("ct_"))
if expr.kind == ckList and expr.items.len > 0:
result = cljList(@[cljSymbol("let"), cljVector(@[gs, result]),
cljList(@[cljSymbol("if"), test,
cljList(expr.items & @[gs]),
gs])])
else:
result = cljList(@[cljSymbol("let"), cljVector(@[gs, result]),
cljList(@[cljSymbol("if"), test,
cljList(@[expr, gs]),
gs])])
return result
)
# doto
defineMacro("doto", proc(args: seq[CljVal]): CljVal =
if args.len < 1:
raise newException(CatchableError, "doto requires initial value and body")
let init = args[0]
let body = args[1..^1]
let gs = cljSymbol(gensymName("dt_"))
var forms: seq[CljVal] = @[]
forms.add(cljSymbol("let"))
forms.add(cljVector(@[gs, init]))
for form in body:
if form.kind == ckList and form.items.len > 0:
forms.add(cljList(@[form.items[0], gs] & form.items[1..^1]))
else:
forms.add(cljList(@[form, gs]))
forms.add(gs)
return cljList(forms)
)
# as->
defineMacro("as->", proc(args: seq[CljVal]): CljVal =
if args.len < 3:
raise newException(CatchableError, "as-> requires name, init, and body")
let name = args[0]
let init = args[1]
let body = args[2..^1]
var result = init
for form in body:
result = cljList(@[cljSymbol("let"), cljVector(@[name, result]), form])
return result
)
# some->
defineMacro("some->", proc(args: seq[CljVal]): CljVal =
if args.len < 1:
raise newException(CatchableError, "some-> requires initial value and body")
let init = args[0]
let body = args[1..^1]
var result = init
for form in body:
let gs = cljSymbol(gensymName("st_"))
if form.kind == ckList and form.items.len > 0:
result = cljList(@[cljSymbol("let"), cljVector(@[gs, result]),
cljList(@[cljSymbol("if"), gs,
cljList(@[form.items[0], gs] & form.items[1..^1]),
cljNil()])])
else:
result = cljList(@[cljSymbol("let"), cljVector(@[gs, result]),
cljList(@[cljSymbol("if"), gs,
cljList(@[form, gs]),
cljNil()])])
return result
)
# some->>
defineMacro("some->>", proc(args: seq[CljVal]): CljVal =
if args.len < 1:
raise newException(CatchableError, "some->> requires initial value and body")
let init = args[0]
let body = args[1..^1]
var result = init
for form in body:
let gs = cljSymbol(gensymName("st_"))
if form.kind == ckList and form.items.len > 0:
result = cljList(@[cljSymbol("let"), cljVector(@[gs, result]),
cljList(@[cljSymbol("if"), gs,
cljList(form.items & @[gs]),
cljNil()])])
else:
result = cljList(@[cljSymbol("let"), cljVector(@[gs, result]),
cljList(@[cljSymbol("if"), gs,
cljList(@[form, gs]),
cljNil()])])
return result
)
# for
defineMacro("for", proc(args: seq[CljVal]): CljVal =
if args.len < 2:
raise newException(CatchableError, "for requires bindings and body")
let bindings = args[0]
let body = args[1..^1]
if bindings.kind != ckVector:
raise newException(CatchableError, "for bindings must be a vector")
let gs = cljSymbol(gensymName("fr_"))
cljList(@[cljSymbol("let"), cljVector(@[gs, cljVector(@[])]),
cljList(@[cljSymbol("doseq")] & @[bindings] & @[
cljList(@[cljSymbol("set!"), gs, cljList(@[cljSymbol("conj"), gs] & body)])]),
gs])
)
# doseq
defineMacro("doseq", proc(args: seq[CljVal]): CljVal =
if args.len < 2:
raise newException(CatchableError, "doseq requires bindings and body")
let bindings = args[0]
let body = args[1..^1]
if bindings.kind != ckVector:
raise newException(CatchableError, "doseq bindings must be a vector")
let bindingPairs = bindings.items.len div 2
if bindingPairs == 1:
let name = bindings.items[0]
let coll = bindings.items[1]
let gs = cljSymbol(gensymName("ds_"))
if name.kind == ckVector:
let seqGs = cljSymbol(gensymName("sq_"))
let tmpGs = cljSymbol(gensymName("tmp_"))
var innerBindings: seq[CljVal] = @[]
for j in 0.. 1: args[1] else: cljString("Assert failed")
cljList(@[cljSymbol("when-not"), test,
cljList(@[cljSymbol("throw"), msg])])
)
# with-open
defineMacro("with-open", proc(args: seq[CljVal]): CljVal =
if args.len < 2:
raise newException(CatchableError, "with-open requires binding and body")
let binding = args[0]
let body = args[1..^1]
if binding.kind != ckVector or binding.items.len != 2:
raise newException(CatchableError, "with-open requires [name init]")
let init = binding.items[1]
let gs = cljSymbol(gensymName("wo_"))
cljList(@[cljSymbol("let"), cljVector(@[gs, init]),
cljList(@[cljSymbol("try")] & body & @[
cljList(@[cljSymbol("finally"),
cljList(@[cljSymbol(".close"), gs])])])])
)
# clojure.test macros
defineMacro("deftest", proc(args: seq[CljVal]): CljVal =
if args.len == 0:
raise newException(CatchableError, "deftest requires name and body")
let name = args[0]
let body = args[1..^1]
cljList(@[cljSymbol("def"), name,
cljList(@[cljSymbol("fn"), cljVector(@[])] & body)])
)
defineMacro("is", proc(args: seq[CljVal]): CljVal =
# is is a no-op for compilation tests
cljNil()
)
defineMacro("testing", proc(args: seq[CljVal]): CljVal =
if args.len == 0: return cljNil()
cljList(@[cljSymbol("do")] & args[1..^1])
)
defineMacro("thrown?", proc(args: seq[CljVal]): CljVal =
if args.len == 0: return cljNil()
let form = args[0]
cljList(@[cljSymbol("try"), form, cljBool(false),
cljList(@[cljSymbol("catch"), cljSymbol("Exception"), cljSymbol("e"), cljBool(true)])])
)
defineMacro("are", proc(args: seq[CljVal]): CljVal =
if args.len < 2:
raise newException(CatchableError, "are requires argv and test cases")
let argv = args[0]
let testExpr = args[1]
let exprs = args[2..^1]
if argv.kind != ckVector:
raise newException(CatchableError, "are argv must be a vector")
let arity = argv.items.len
if exprs.len mod arity != 0:
raise newException(CatchableError, "are test cases must match argv arity")
var isForms: seq[CljVal] = @[]
for i in countup(0, exprs.len - arity, arity):
var bindings: seq[CljVal] = @[]
for j in 0..