Files
bara-lang/lib/cljnim_runtime.nim
T

1181 lines
35 KiB
Nim

import strutils, sequtils, hashes, algorithm, os, osproc
type
CljKind* = enum
ckNil, ckBool, ckInt, ckFloat, ckString, ckKeyword, ckSymbol,
ckList, ckVector, ckMap, ckFn, ckAtom
CljVal* = ref CljValObj
CljValObj = object
case kind*: CljKind
of ckNil: discard
of ckBool: boolVal*: bool
of ckInt: intVal*: int64
of ckFloat: floatVal*: float64
of ckString: strVal*: string
of ckKeyword: kwName*: string
of ckSymbol: symName*: string
of ckList: listItems*: seq[CljVal]
of ckVector: vecData*: seq[CljVal]
of ckMap:
mapKeys*: seq[CljVal]
mapVals*: seq[CljVal]
of ckFn: fnProc*: proc(args: seq[CljVal]): CljVal
of ckAtom: atomVal*: CljVal
# ---- Constructors ----
proc cljNil*(): CljVal = CljVal(kind: ckNil)
proc cljBool*(v: bool): CljVal = CljVal(kind: ckBool, boolVal: v)
proc cljInt*(v: int64): CljVal = CljVal(kind: ckInt, intVal: v)
proc cljInt*(v: int): CljVal = CljVal(kind: ckInt, intVal: v.int64)
proc cljFloat*(v: float64): CljVal = CljVal(kind: ckFloat, floatVal: v)
proc cljString*(v: string): CljVal = CljVal(kind: ckString, strVal: v)
proc cljKeyword*(v: string): CljVal = CljVal(kind: ckKeyword, kwName: v)
proc cljSymbol*(v: string): CljVal = CljVal(kind: ckSymbol, symName: v)
proc cljList*(items: seq[CljVal]): CljVal = CljVal(kind: ckList, listItems: items)
proc cljVector*(items: seq[CljVal]): CljVal = CljVal(kind: ckVector, vecData: items)
proc cljFn*(p: proc(args: seq[CljVal]): CljVal): CljVal = CljVal(kind: ckFn, fnProc: p)
proc cljMap*(keys, vals: seq[CljVal]): CljVal =
CljVal(kind: ckMap, mapKeys: keys, mapVals: vals)
proc cljMapFromPairs*(pairs: seq[(CljVal, CljVal)]): CljVal =
var ks: seq[CljVal] = @[]
var vs: seq[CljVal] = @[]
for (k, v) in pairs:
ks.add(k)
vs.add(v)
cljMap(ks, vs)
# ---- Equality ----
proc `==`*(a, b: CljVal): bool =
if a.isNil and b.isNil: return true
if a.isNil or b.isNil: return false
if a.kind != b.kind: return false
case a.kind
of ckNil: true
of ckBool: a.boolVal == b.boolVal
of ckInt: a.intVal == b.intVal
of ckFloat: a.floatVal == b.floatVal
of ckString: a.strVal == b.strVal
of ckKeyword: a.kwName == b.kwName
of ckSymbol: a.symName == b.symName
else: false
# ---- Display ----
proc cljRepr*(v: CljVal): string =
if v.isNil: return "nil"
case v.kind
of ckNil: "nil"
of ckBool: $v.boolVal
of ckInt: $v.intVal
of ckFloat: $v.floatVal
of ckString: "\"" & v.strVal.replace("\"", "\\\"") & "\""
of ckKeyword: ":" & v.kwName
of ckSymbol: v.symName
of ckList: "(" & v.listItems.mapIt(cljRepr(it)).join(" ") & ")"
of ckVector: "[" & v.vecData.mapIt(cljRepr(it)).join(" ") & "]"
of ckMap:
var parts: seq[string] = @[]
for i in 0..<v.mapKeys.len:
parts.add(cljRepr(v.mapKeys[i]) & " " & cljRepr(v.mapVals[i]))
"{" & parts.join(", ") & "}"
of ckFn: "#<fn>"
of ckAtom: "(atom " & cljRepr(v.atomVal) & ")"
proc cljStr*(v: CljVal): string =
if v.isNil: return ""
case v.kind
of ckString: v.strVal
of ckKeyword: ":" & v.kwName
of ckSymbol: v.symName
else: cljRepr(v)
# ---- Type predicates ----
proc cljIsNil*(v: CljVal): bool = v.isNil or v.kind == ckNil
proc cljIsTrue*(v: CljVal): bool = v.kind == ckBool and v.boolVal
proc cljIsFalse*(v: CljVal): bool = v.kind == ckBool and not v.boolVal
proc cljIsTruthy*(v: CljVal): bool = not cljIsNil(v) and not cljIsFalse(v)
# ---- I/O ----
proc cljPrintln*(args: seq[CljVal]): CljVal =
var parts: seq[string] = @[]
for a in args:
parts.add(cljStr(a))
echo parts.join(" ")
cljNil()
proc cljPrn*(args: seq[CljVal]): CljVal =
var parts: seq[string] = @[]
for a in args:
parts.add(cljRepr(a))
echo parts.join(" ")
cljNil()
# ---- Arithmetic ----
proc cljAdd*(args: seq[CljVal]): CljVal =
var sum: int64 = 0
var sumF: float64 = 0.0
var isFloat = false
for a in args:
case a.kind
of ckInt: sum += a.intVal
of ckFloat:
sumF += a.floatVal
isFloat = true
else: raise newException(CatchableError, "+ requires numbers")
if isFloat: cljFloat(sum.float64 + sumF)
else: cljInt(sum)
proc cljMul*(args: seq[CljVal]): CljVal =
var product: int64 = 1
var productF: float64 = 1.0
var isFloat = false
for a in args:
case a.kind
of ckInt: product *= a.intVal
of ckFloat:
productF *= a.floatVal
isFloat = true
else: raise newException(CatchableError, "* requires numbers")
if isFloat: cljFloat(product.float64 * productF)
else: cljInt(product)
proc cljSub*(args: seq[CljVal]): CljVal =
if args.len == 0: raise newException(CatchableError, "- requires at least 1 argument")
if args.len == 1:
case args[0].kind
of ckInt: return cljInt(-args[0].intVal)
of ckFloat: return cljFloat(-args[0].floatVal)
else: raise newException(CatchableError, "- requires numbers")
var r: int64
var rF: float64
var isFloat = false
case args[0].kind
of ckInt: r = args[0].intVal
of ckFloat:
rF = args[0].floatVal
isFloat = true
else: raise newException(CatchableError, "- requires numbers")
for i in 1..<args.len:
case args[i].kind
of ckInt:
if isFloat: rF -= args[i].intVal.float64
else: r -= args[i].intVal
of ckFloat:
if not isFloat:
rF = r.float64 - args[i].floatVal
isFloat = true
else:
rF -= args[i].floatVal
else: raise newException(CatchableError, "- requires numbers")
if isFloat: cljFloat(rF)
else: cljInt(r)
proc cljDiv*(args: seq[CljVal]): CljVal =
if args.len < 2: raise newException(CatchableError, "/ requires at least 2 arguments")
var r: float64
case args[0].kind
of ckInt: r = args[0].intVal.float64
of ckFloat: r = args[0].floatVal
else: raise newException(CatchableError, "/ requires numbers")
for i in 1..<args.len:
case args[i].kind
of ckInt:
if args[i].intVal == 0: raise newException(CatchableError, "Division by zero")
r /= args[i].intVal.float64
of ckFloat:
if args[i].floatVal == 0.0: raise newException(CatchableError, "Division by zero")
r /= args[i].floatVal
else: raise newException(CatchableError, "/ requires numbers")
cljFloat(r)
proc cljInc*(v: CljVal): CljVal =
case v.kind
of ckInt: cljInt(v.intVal + 1)
of ckFloat: cljFloat(v.floatVal + 1.0)
else: raise newException(CatchableError, "inc requires a number")
proc cljDec*(v: CljVal): CljVal =
case v.kind
of ckInt: cljInt(v.intVal - 1)
of ckFloat: cljFloat(v.floatVal - 1.0)
else: raise newException(CatchableError, "dec requires a number")
proc cljMod*(a, b: CljVal): CljVal =
if a.kind == ckInt and b.kind == ckInt:
cljInt(a.intVal mod b.intVal)
else:
raise newException(CatchableError, "mod requires integers")
proc cljAbs*(v: CljVal): CljVal =
case v.kind
of ckInt: cljInt(abs(v.intVal))
of ckFloat: cljFloat(abs(v.floatVal))
else: raise newException(CatchableError, "abs requires a number")
proc cljMin*(args: seq[CljVal]): CljVal =
if args.len == 0: raise newException(CatchableError, "min requires at least 1 argument")
result = args[0]
for i in 1..<args.len:
if args[i].kind == ckInt and result.kind == ckInt:
if args[i].intVal < result.intVal: result = args[i]
proc cljMax*(args: seq[CljVal]): CljVal =
if args.len == 0: raise newException(CatchableError, "max requires at least 1 argument")
result = args[0]
for i in 1..<args.len:
if args[i].kind == ckInt and result.kind == ckInt:
if args[i].intVal > result.intVal: result = args[i]
# ---- Comparison ----
proc cljNumEq*(args: seq[CljVal]): CljVal =
if args.len < 2: return cljBool(true)
for i in 1..<args.len:
let a = args[i-1]
let b = args[i]
if a.kind == ckInt and b.kind == ckInt:
if a.intVal != b.intVal: return cljBool(false)
elif a.kind == ckFloat and b.kind == ckFloat:
if a.floatVal != b.floatVal: return cljBool(false)
elif a.kind == ckInt and b.kind == ckFloat:
if a.intVal.float64 != b.floatVal: return cljBool(false)
elif a.kind == ckFloat and b.kind == ckInt:
if a.floatVal != b.intVal.float64: return cljBool(false)
else:
return cljBool(false)
cljBool(true)
proc cljLt*(args: seq[CljVal]): CljVal =
if args.len < 2: return cljBool(true)
for i in 1..<args.len:
let a = args[i-1]
let b = args[i]
if a.kind == ckInt and b.kind == ckInt:
if a.intVal >= b.intVal: return cljBool(false)
elif a.kind == ckFloat and b.kind == ckFloat:
if a.floatVal >= b.floatVal: return cljBool(false)
else: return cljBool(false)
cljBool(true)
proc cljGt*(args: seq[CljVal]): CljVal =
if args.len < 2: return cljBool(true)
for i in 1..<args.len:
let a = args[i-1]
let b = args[i]
if a.kind == ckInt and b.kind == ckInt:
if a.intVal <= b.intVal: return cljBool(false)
elif a.kind == ckFloat and b.kind == ckFloat:
if a.floatVal <= b.floatVal: return cljBool(false)
else: return cljBool(false)
cljBool(true)
proc cljLe*(args: seq[CljVal]): CljVal =
if args.len < 2: return cljBool(true)
for i in 1..<args.len:
let a = args[i-1]
let b = args[i]
if a.kind == ckInt and b.kind == ckInt:
if a.intVal > b.intVal: return cljBool(false)
else: return cljBool(false)
cljBool(true)
proc cljGe*(args: seq[CljVal]): CljVal =
if args.len < 2: return cljBool(true)
for i in 1..<args.len:
let a = args[i-1]
let b = args[i]
if a.kind == ckInt and b.kind == ckInt:
if a.intVal < b.intVal: return cljBool(false)
else: return cljBool(false)
cljBool(true)
proc cljNot*(v: CljVal): CljVal =
cljBool(not cljIsTruthy(v))
# ---- Predicates ----
proc cljZero*(v: CljVal): CljVal =
case v.kind
of ckInt: cljBool(v.intVal == 0)
of ckFloat: cljBool(v.floatVal == 0.0)
else: cljBool(false)
proc cljPos*(v: CljVal): CljVal =
case v.kind
of ckInt: cljBool(v.intVal > 0)
of ckFloat: cljBool(v.floatVal > 0.0)
else: raise newException(CatchableError, "pos? requires a number")
proc cljNeg*(v: CljVal): CljVal =
case v.kind
of ckInt: cljBool(v.intVal < 0)
of ckFloat: cljBool(v.floatVal < 0.0)
else: raise newException(CatchableError, "neg? requires a number")
proc cljEven*(v: CljVal): CljVal =
if v.kind == ckInt: cljBool(v.intVal mod 2 == 0)
else: raise newException(CatchableError, "even? requires an integer")
proc cljOdd*(v: CljVal): CljVal =
if v.kind == ckInt: cljBool(v.intVal mod 2 != 0)
else: raise newException(CatchableError, "odd? requires an integer")
# ---- Collection operations ----
proc cljCount*(v: CljVal): int =
if v.isNil: return 0
case v.kind
of ckList: v.listItems.len
of ckVector: v.vecData.len
of ckMap: v.mapKeys.len
of ckString: v.strVal.len
else: 0
proc cljFirst*(v: CljVal): CljVal =
if v.isNil: return cljNil()
case v.kind
of ckList:
if v.listItems.len == 0: cljNil()
else: v.listItems[0]
of ckVector:
if v.vecData.len == 0: cljNil()
else: v.vecData[0]
else: cljNil()
proc cljRest*(v: CljVal): CljVal =
if v.isNil: return cljList(@[])
case v.kind
of ckList:
if v.listItems.len <= 1: cljList(@[])
else: cljList(v.listItems[1..^1])
of ckVector:
if v.vecData.len <= 1: cljList(@[])
else: cljList(v.vecData[1..^1])
else: cljList(@[])
proc cljNext*(v: CljVal): CljVal =
let r = cljRest(v)
if r.kind == ckList and r.listItems.len == 0:
return cljNil()
r
proc cljLast*(v: CljVal): CljVal =
if v.isNil: return cljNil()
case v.kind
of ckList:
if v.listItems.len == 0: cljNil()
else: v.listItems[^1]
of ckVector:
if v.vecData.len == 0: cljNil()
else: v.vecData[^1]
else: cljNil()
proc cljNth*(v: CljVal, n: int): CljVal =
case v.kind
of ckList:
if n < 0 or n >= v.listItems.len:
raise newException(IndexDefect, "nth: index out of range")
v.listItems[n]
of ckVector:
if n < 0 or n >= v.vecData.len:
raise newException(IndexDefect, "nth: index out of range")
v.vecData[n]
else:
raise newException(CatchableError, "nth requires a collection")
proc cljConj*(coll: CljVal, item: CljVal): CljVal =
if coll.isNil:
return cljList(@[item])
case coll.kind
of ckList:
var newItems = @[item]
newItems.add(coll.listItems)
cljList(newItems)
of ckVector:
var newItems = coll.vecData
newItems.add(item)
cljVector(newItems)
else:
cljList(@[item])
proc cljCons*(item: CljVal, coll: CljVal): CljVal =
if coll.isNil:
return cljList(@[item])
case coll.kind
of ckList:
var newItems = @[item]
newItems.add(coll.listItems)
cljList(newItems)
of ckVector:
var newItems = @[item]
newItems.add(coll.vecData)
cljList(newItems)
else:
cljList(@[item])
proc cljSeq*(v: CljVal): CljVal =
if v.isNil: return cljNil()
case v.kind
of ckList:
if v.listItems.len == 0: cljNil()
else: v
of ckVector:
if v.vecData.len == 0: cljNil()
else: cljList(v.vecData)
of ckString:
if v.strVal.len == 0: cljNil()
else:
var chars: seq[CljVal] = @[]
for c in v.strVal:
chars.add(cljString($c))
cljList(chars)
else: cljNil()
proc cljVec*(v: CljVal): CljVal =
if v.isNil: return cljVector(@[])
case v.kind
of ckList: cljVector(v.listItems)
of ckVector: v
else: cljVector(@[v])
proc cljEmpty*(v: CljVal): CljVal =
cljBool(cljCount(v) == 0)
proc cljConcat*(args: seq[CljVal]): CljVal =
var items: seq[CljVal] = @[]
for a in args:
if not a.isNil:
case a.kind
of ckList: items.add(a.listItems)
of ckVector: items.add(a.vecData)
else: discard
cljList(items)
proc cljTake*(n: int, coll: CljVal): CljVal =
if coll.isNil: return cljList(@[])
case coll.kind
of ckList: cljList(coll.listItems[0..<min(n, coll.listItems.len)])
of ckVector: cljList(coll.vecData[0..<min(n, coll.vecData.len)])
else: cljList(@[])
proc cljDrop*(n: int, coll: CljVal): CljVal =
if coll.isNil: return cljList(@[])
case coll.kind
of ckList: cljList(coll.listItems[min(n, coll.listItems.len)..^1])
of ckVector: cljList(coll.vecData[min(n, coll.vecData.len)..^1])
else: cljList(@[])
proc cljReverse*(coll: CljVal): CljVal =
if coll.isNil: return cljList(@[])
case coll.kind
of ckList:
var items = coll.listItems
items.reverse()
cljList(items)
of ckVector:
var items = coll.vecData
items.reverse()
cljList(items)
else: cljList(@[])
proc cljSort*(coll: CljVal): CljVal =
if coll.isNil: return cljList(@[])
case coll.kind
of ckList:
var items = coll.listItems
items.sort(proc(a, b: CljVal): int =
if a.kind == ckInt and b.kind == ckInt:
return cmp(a.intVal, b.intVal)
return 0)
cljList(items)
of ckVector:
var items = coll.vecData
items.sort(proc(a, b: CljVal): int =
if a.kind == ckInt and b.kind == ckInt:
return cmp(a.intVal, b.intVal)
return 0)
cljList(items)
else: coll
proc cljDistinct*(coll: CljVal): CljVal =
if coll.isNil: return cljList(@[])
var seen: seq[CljVal] = @[]
case coll.kind
of ckList:
for item in coll.listItems:
if item notin seen:
seen.add(item)
cljList(seen)
of ckVector:
for item in coll.vecData:
if item notin seen:
seen.add(item)
cljList(seen)
else: coll
proc cljFlatten*(coll: CljVal): CljVal =
if coll.isNil: return cljList(@[])
var result: seq[CljVal] = @[]
proc flattenHelper(v: CljVal) =
if v.isNil: return
case v.kind
of ckList:
for item in v.listItems:
flattenHelper(item)
of ckVector:
for item in v.vecData:
flattenHelper(item)
else:
result.add(v)
flattenHelper(coll)
cljList(result)
proc cljPartition*(n: int, coll: CljVal): CljVal =
if coll.isNil: return cljList(@[])
var items: seq[CljVal]
case coll.kind
of ckList: items = coll.listItems
of ckVector: items = coll.vecData
else: return cljList(@[])
var parts: seq[CljVal] = @[]
var i = 0
while i + n <= items.len:
parts.add(cljList(items[i..<i+n]))
i += n
cljList(parts)
proc cljFrequencies*(coll: CljVal): CljVal =
if coll.isNil: return cljMap(@[], @[])
var keys: seq[CljVal] = @[]
var vals: seq[CljVal] = @[]
var items: seq[CljVal]
case coll.kind
of ckList: items = coll.listItems
of ckVector: items = coll.vecData
else: return cljMap(@[], @[])
for item in items:
var found = false
for j in 0..<keys.len:
if keys[j] == item:
vals[j] = cljInt(vals[j].intVal + 1)
found = true
break
if not found:
keys.add(item)
vals.add(cljInt(1))
cljMap(keys, vals)
proc cljGroupBy*(f: proc(args: seq[CljVal]): CljVal, coll: CljVal): CljVal =
if coll.isNil: return cljMap(@[], @[])
var keys: seq[CljVal] = @[]
var vals: seq[CljVal] = @[]
var items: seq[CljVal]
case coll.kind
of ckList: items = coll.listItems
of ckVector: items = coll.vecData
else: return cljMap(@[], @[])
for item in items:
let key = f(@[item])
var found = false
for j in 0..<keys.len:
if keys[j] == key:
case vals[j].kind
of ckList:
var newItems = vals[j].listItems
newItems.add(item)
vals[j] = cljList(newItems)
else: discard
found = true
break
if not found:
keys.add(key)
vals.add(cljList(@[item]))
cljMap(keys, vals)
proc cljGroupBy*(f: CljVal, coll: CljVal): CljVal =
if f.kind == ckFn: cljGroupBy(f.fnProc, coll)
else: raise newException(CatchableError, "group-by requires a function")
# ---- Map operations ----
proc cljGet*(m: CljVal, key: CljVal): CljVal =
if m.isNil or m.kind != ckMap: return cljNil()
for i in 0..<m.mapKeys.len:
if m.mapKeys[i] == key:
return m.mapVals[i]
cljNil()
proc cljGetDefault*(m: CljVal, key: CljVal, default: CljVal): CljVal =
let v = cljGet(m, key)
if cljIsNil(v): default
else: v
proc cljAssoc*(m: CljVal, key: CljVal, val: CljVal): CljVal =
if m.isNil or m.kind != ckMap:
return cljMap(@[key], @[val])
var newKeys = m.mapKeys
var newVals = m.mapVals
for i in 0..<newKeys.len:
if newKeys[i] == key:
newVals[i] = val
return cljMap(newKeys, newVals)
newKeys.add(key)
newVals.add(val)
cljMap(newKeys, newVals)
proc cljDissoc*(m: CljVal, key: CljVal): CljVal =
if m.isNil or m.kind != ckMap: return cljMap(@[], @[])
var newKeys: seq[CljVal] = @[]
var newVals: seq[CljVal] = @[]
for i in 0..<m.mapKeys.len:
if m.mapKeys[i] != key:
newKeys.add(m.mapKeys[i])
newVals.add(m.mapVals[i])
cljMap(newKeys, newVals)
proc cljContains*(m: CljVal, key: CljVal): bool =
if m.isNil or m.kind != ckMap: return false
for i in 0..<m.mapKeys.len:
if m.mapKeys[i] == key:
return true
false
proc cljKeys*(m: CljVal): CljVal =
if m.isNil or m.kind != ckMap: return cljList(@[])
cljList(m.mapKeys)
proc cljVals*(m: CljVal): CljVal =
if m.isNil or m.kind != ckMap: return cljList(@[])
cljList(m.mapVals)
proc cljSelectKeys*(m: CljVal, keys: seq[CljVal]): CljVal =
if m.isNil or m.kind != ckMap: return cljMap(@[], @[])
var newKeys: seq[CljVal] = @[]
var newVals: seq[CljVal] = @[]
for key in keys:
for i in 0..<m.mapKeys.len:
if m.mapKeys[i] == key:
newKeys.add(key)
newVals.add(m.mapVals[i])
break
cljMap(newKeys, newVals)
proc cljMerge*(args: seq[CljVal]): CljVal =
var keys: seq[CljVal] = @[]
var vals: seq[CljVal] = @[]
for m in args:
if not m.isNil and m.kind == ckMap:
for i in 0..<m.mapKeys.len:
var found = false
for j in 0..<keys.len:
if keys[j] == m.mapKeys[i]:
vals[j] = m.mapVals[i]
found = true
break
if not found:
keys.add(m.mapKeys[i])
vals.add(m.mapVals[i])
cljMap(keys, vals)
# ---- Higher-order functions ----
proc cljMapSeq*(f: proc(args: seq[CljVal]): CljVal, coll: seq[CljVal]): seq[CljVal] =
result = @[]
for item in coll:
result.add(f(@[item]))
proc cljFilterSeq*(f: proc(args: seq[CljVal]): CljVal, coll: seq[CljVal]): seq[CljVal] =
result = @[]
for item in coll:
let r = f(@[item])
if cljIsTruthy(r):
result.add(item)
proc cljReduceSeq*(f: proc(args: seq[CljVal]): CljVal, init: CljVal, coll: seq[CljVal]): CljVal =
result = init
for item in coll:
result = f(@[result, item])
proc cljMap*(f: proc(args: seq[CljVal]): CljVal, coll: CljVal): CljVal =
if coll.isNil: return cljList(@[])
case coll.kind
of ckList: cljList(cljMapSeq(f, coll.listItems))
of ckVector: cljList(cljMapSeq(f, coll.vecData))
else: cljList(@[])
proc cljMap*(f: CljVal, coll: CljVal): CljVal =
if f.kind == ckFn: cljMap(f.fnProc, coll)
else: raise newException(CatchableError, "map requires a function")
proc cljFilter*(f: proc(args: seq[CljVal]): CljVal, coll: CljVal): CljVal =
if coll.isNil: return cljList(@[])
case coll.kind
of ckList: cljList(cljFilterSeq(f, coll.listItems))
of ckVector: cljList(cljFilterSeq(f, coll.vecData))
else: cljList(@[])
proc cljFilter*(f: CljVal, coll: CljVal): CljVal =
if f.kind == ckFn: cljFilter(f.fnProc, coll)
else: raise newException(CatchableError, "filter requires a function")
proc cljReduce*(f: proc(args: seq[CljVal]): CljVal, init: CljVal, coll: CljVal): CljVal =
if coll.isNil: return init
case coll.kind
of ckList: cljReduceSeq(f, init, coll.listItems)
of ckVector: cljReduceSeq(f, init, coll.vecData)
else: init
proc cljReduce*(f: CljVal, init: CljVal, coll: CljVal): CljVal =
if f.kind == ckFn: cljReduce(f.fnProc, init, coll)
else: raise newException(CatchableError, "reduce requires a function")
proc cljMapv*(f: proc(args: seq[CljVal]): CljVal, coll: CljVal): CljVal =
if coll.isNil: return cljVector(@[])
case coll.kind
of ckList: cljVector(cljMapSeq(f, coll.listItems))
of ckVector: cljVector(cljMapSeq(f, coll.vecData))
else: cljVector(@[])
proc cljMapv*(f: CljVal, coll: CljVal): CljVal =
if f.kind == ckFn: cljMapv(f.fnProc, coll)
else: raise newException(CatchableError, "mapv requires a function")
proc cljSome*(f: CljVal, coll: CljVal): CljVal =
if coll.isNil: return cljNil()
let fn = f.fnProc
var items: seq[CljVal]
case coll.kind
of ckList: items = coll.listItems
of ckVector: items = coll.vecData
else: return cljNil()
for item in items:
let r = fn(@[item])
if cljIsTruthy(r):
return r
cljNil()
proc cljEvery*(f: CljVal, coll: CljVal): CljVal =
if coll.isNil: return cljBool(true)
let fn = f.fnProc
var items: seq[CljVal]
case coll.kind
of ckList: items = coll.listItems
of ckVector: items = coll.vecData
else: return cljBool(true)
for item in items:
let r = fn(@[item])
if not cljIsTruthy(r):
return cljBool(false)
cljBool(true)
proc cljApply*(f: CljVal, args: CljVal): CljVal =
if f.kind != ckFn: raise newException(CatchableError, "apply requires a function")
var argSeq: seq[CljVal] = @[]
if not args.isNil:
case args.kind
of ckList: argSeq = args.listItems
of ckVector: argSeq = args.vecData
else: argSeq = @[args]
f.fnProc(argSeq)
proc cljComp*(fns: seq[CljVal]): CljVal =
let realFns = fns.mapIt(it.fnProc)
cljFn(proc(args: seq[CljVal]): CljVal =
result = realFns[^1](args)
for i in countdown(realFns.len - 2, 0):
result = realFns[i](@[result]))
proc cljPartial*(f: CljVal, partialArgs: seq[CljVal]): CljVal =
let realF = f.fnProc
cljFn(proc(args: seq[CljVal]): CljVal =
var allArgs = partialArgs
allArgs.add(args)
realF(allArgs))
proc cljJuxt*(fns: seq[CljVal]): CljVal =
let realFns = fns.mapIt(it.fnProc)
cljFn(proc(args: seq[CljVal]): CljVal =
var results: seq[CljVal] = @[]
for f in realFns:
results.add(f(args))
cljList(results))
proc cljComplement*(f: CljVal): CljVal =
let realF = f.fnProc
cljFn(proc(args: seq[CljVal]): CljVal =
cljNot(realF(args)))
# ---- String functions ----
proc cljStrConcat*(args: seq[CljVal]): CljVal =
var s = ""
for a in args:
s.add(cljStr(a))
cljString(s)
proc cljPrStrConcat*(args: seq[CljVal]): CljVal =
var parts: seq[string] = @[]
for a in args:
parts.add(cljRepr(a))
cljString(parts.join(" "))
proc cljSubs*(s: CljVal, startIdx: int): CljVal =
if s.kind != ckString: raise newException(CatchableError, "subs requires a string")
if startIdx < 0 or startIdx >= s.strVal.len:
raise newException(IndexDefect, "subs: index out of range")
cljString(s.strVal[startIdx..^1])
proc cljSubsRange*(s: CljVal, startIdx, endIdx: int): CljVal =
if s.kind != ckString: raise newException(CatchableError, "subs requires a string")
if startIdx < 0 or startIdx > endIdx or endIdx > s.strVal.len:
raise newException(IndexDefect, "subs: index out of range")
cljString(s.strVal[startIdx..<endIdx])
proc cljStrJoin*(args: seq[CljVal]): CljVal =
if args.len == 0: return cljString("")
if args.len == 1:
case args[0].kind
of ckList: return cljString(args[0].listItems.mapIt(cljStr(it)).join(""))
of ckVector: return cljString(args[0].vecData.mapIt(cljStr(it)).join(""))
else: return cljString(cljStr(args[0]))
let sep = cljStr(args[0])
case args[1].kind
of ckList: cljString(args[1].listItems.mapIt(cljStr(it)).join(sep))
of ckVector: cljString(args[1].vecData.mapIt(cljStr(it)).join(sep))
else: cljString(cljStr(args[1]))
proc cljStrSplit*(s: CljVal, sep: CljVal): CljVal =
if s.kind != ckString: raise newException(CatchableError, "split requires a string")
let parts = s.strVal.split(cljStr(sep))
var items: seq[CljVal] = @[]
for p in parts:
items.add(cljString(p))
cljList(items)
proc cljStrReplace*(s: CljVal, match: CljVal, replacement: CljVal): CljVal =
if s.kind != ckString: raise newException(CatchableError, "replace requires a string")
cljString(s.strVal.replace(cljStr(match), cljStr(replacement)))
proc cljStrTrim*(s: CljVal): CljVal =
if s.kind != ckString: raise newException(CatchableError, "trim requires a string")
cljString(s.strVal.strip())
proc cljStrStartsWith*(s: CljVal, prefix: CljVal): CljVal =
if s.kind != ckString: raise newException(CatchableError, "starts-with? requires a string")
cljBool(s.strVal.startsWith(cljStr(prefix)))
proc cljStrEndsWith*(s: CljVal, suffix: CljVal): CljVal =
if s.kind != ckString: raise newException(CatchableError, "ends-with? requires a string")
cljBool(s.strVal.endsWith(cljStr(suffix)))
proc cljStrIncludes*(s: CljVal, sub: CljVal): CljVal =
if s.kind != ckString: raise newException(CatchableError, "includes? requires a string")
cljBool(cljStr(sub) in s.strVal)
proc cljStrUpper*(s: CljVal): CljVal =
if s.kind != ckString: raise newException(CatchableError, "upper-case requires a string")
cljString(s.strVal.toUpper())
proc cljStrLower*(s: CljVal): CljVal =
if s.kind != ckString: raise newException(CatchableError, "lower-case requires a string")
cljString(s.strVal.toLower())
# ---- Misc ----
proc cljIdentity*(args: seq[CljVal]): CljVal =
if args.len == 0: cljNil()
else: args[0]
proc cljConstantly*(v: CljVal): proc(args: seq[CljVal]): CljVal =
proc(args: seq[CljVal]): CljVal = v
proc cljType*(v: CljVal): CljVal =
if v.isNil: return cljKeyword("nil")
case v.kind
of ckNil: cljKeyword("nil")
of ckBool: cljKeyword("boolean")
of ckInt: cljKeyword("integer")
of ckFloat: cljKeyword("float")
of ckString: cljKeyword("string")
of ckKeyword: cljKeyword("keyword")
of ckSymbol: cljKeyword("symbol")
of ckList: cljKeyword("list")
of ckVector: cljKeyword("vector")
of ckMap: cljKeyword("map")
of ckFn: cljKeyword("function")
of ckAtom: cljKeyword("atom")
proc cljAtom*(v: CljVal): CljVal =
CljVal(kind: ckAtom, atomVal: v)
proc cljDeref*(a: CljVal): CljVal =
if a.kind == ckAtom: a.atomVal
else: raise newException(CatchableError, "deref requires an atom")
proc cljReset*(a: CljVal, v: CljVal): CljVal =
if a.kind == ckAtom:
a.atomVal = v
v
else:
raise newException(CatchableError, "reset! requires an atom")
proc cljSwap*(a: CljVal, f: proc(args: seq[CljVal]): CljVal, args: seq[CljVal]): CljVal =
if a.kind == ckAtom:
var fargs = @[a.atomVal]
fargs.add(args)
a.atomVal = f(fargs)
a.atomVal
else:
raise newException(CatchableError, "swap! requires an atom")
proc cljSwap*(a: CljVal, f: CljVal, args: seq[CljVal] = @[]): CljVal =
if f.kind == ckFn: cljSwap(a, f.fnProc, args)
else: raise newException(CatchableError, "swap! requires a function")
# ---- Additional functions needed by emitter ----
proc cljNotEq*(args: seq[CljVal]): CljVal =
cljNot(cljNumEq(args))
proc cljGetIn*(m: CljVal, keys: CljVal, default: CljVal = nil): CljVal =
if keys.isNil or keys.kind != ckList:
if default != nil: return default
return cljNil()
var current = m
for key in keys.listItems:
if current.isNil or current.kind != ckMap:
if default != nil: return default
return cljNil()
current = cljGet(current, key)
if cljIsNil(current):
if default != nil: return default
return cljNil()
current
proc cljInto*(to: CljVal, src: CljVal): CljVal =
if src.isNil: return to
case to.kind
of ckVector:
case src.kind
of ckList:
var items = to.vecData
items.add(src.listItems)
cljVector(items)
of ckVector:
var items = to.vecData
items.add(src.vecData)
cljVector(items)
else: to
of ckList:
case src.kind
of ckList:
var items = to.listItems
items.add(src.listItems)
cljList(items)
of ckVector:
var items = to.listItems
items.add(src.vecData)
cljList(items)
else: to
of ckMap:
if src.kind == ckMap:
var keys = to.mapKeys
var vals = to.mapVals
for i in 0..<src.mapKeys.len:
var found = false
for j in 0..<keys.len:
if keys[j] == src.mapKeys[i]:
vals[j] = src.mapVals[i]
found = true
break
if not found:
keys.add(src.mapKeys[i])
vals.add(src.mapVals[i])
cljMap(keys, vals)
elif src.kind == ckVector:
var keys = to.mapKeys
var vals = to.mapVals
for pair in src.vecData:
if pair.kind == ckVector and pair.vecData.len == 2:
var found = false
for j in 0..<keys.len:
if keys[j] == pair.vecData[0]:
vals[j] = pair.vecData[1]
found = true
break
if not found:
keys.add(pair.vecData[0])
vals.add(pair.vecData[1])
cljMap(keys, vals)
elif src.kind == ckVector:
var keys = to.mapKeys
var vals = to.mapVals
for pair in src.vecData:
if pair.kind == ckVector and pair.vecData.len == 2:
var found = false
for j in 0..<keys.len:
if keys[j] == pair.vecData[0]:
vals[j] = pair.vecData[1]
found = true
break
if not found:
keys.add(pair.vecData[0])
vals.add(pair.vecData[1])
cljMap(keys, vals)
else: to
else: to
proc cljUpdate*(m: CljVal, key: CljVal, f: proc(args: seq[CljVal]): CljVal, extra: seq[CljVal] = @[]): CljVal =
if m.isNil or m.kind != ckMap: return m
let current = cljGet(m, key)
var fargs = @[current]
fargs.add(extra)
let newVal = f(fargs)
cljAssoc(m, key, newVal)
proc cljUpdate*(m: CljVal, key: CljVal, f: CljVal, extra: seq[CljVal] = @[]): CljVal =
if f.kind == ckFn: cljUpdate(m, key, f.fnProc, extra)
else: raise newException(CatchableError, "update requires a function")
proc cljAssocIn*(m: CljVal, keys: CljVal, val: CljVal): CljVal =
if keys.isNil or keys.kind != ckList or keys.listItems.len == 0:
return m
if keys.listItems.len == 1:
return cljAssoc(m, keys.listItems[0], val)
let firstKey = keys.listItems[0]
let restKeys = cljList(keys.listItems[1..^1])
let inner = cljGet(m, firstKey)
let updated = cljAssocIn(inner, restKeys, val)
cljAssoc(m, firstKey, updated)
proc cljRange*(n: CljVal): CljVal =
if n.kind != ckInt: raise newException(CatchableError, "range requires an integer")
var items: seq[CljVal] = @[]
for i in 0..<n.intVal:
items.add(cljInt(i))
cljList(items)
proc cljRange*(start, finish: CljVal): CljVal =
if start.kind != ckInt or finish.kind != ckInt:
raise newException(CatchableError, "range requires integers")
var items: seq[CljVal] = @[]
for i in start.intVal..<finish.intVal:
items.add(cljInt(i))
cljList(items)
# ---- File Operations ----
proc cljFileRead*(path: CljVal): CljVal =
if path.kind != ckString:
return cljMapFromPairs(@[(cljKeyword("error"), cljString("file/read requires a string path"))])
try:
let content = readFile(path.strVal)
cljString(content)
except CatchableError as e:
cljMapFromPairs(@[(cljKeyword("error"), cljString(e.msg))])
proc cljFileWrite*(path, content: CljVal): CljVal =
if path.kind != ckString or content.kind != ckString:
return cljMapFromPairs(@[(cljKeyword("error"), cljString("file/write requires two strings"))])
try:
writeFile(path.strVal, content.strVal)
cljBool(true)
except CatchableError as e:
cljMapFromPairs(@[(cljKeyword("error"), cljString(e.msg))])
proc cljFileAppend*(path, content: CljVal): CljVal =
if path.kind != ckString or content.kind != ckString:
return cljMapFromPairs(@[(cljKeyword("error"), cljString("file/append requires two strings"))])
try:
let f = open(path.strVal, fmAppend)
f.write(content.strVal)
f.close()
cljBool(true)
except CatchableError as e:
cljMapFromPairs(@[(cljKeyword("error"), cljString(e.msg))])
proc cljFileLs*(dir: CljVal): CljVal =
let path = if dir.kind == ckString: dir.strVal else: "."
var items: seq[CljVal] = @[]
try:
for kind, name in walkDir(path):
items.add(cljString(name))
cljVector(items)
except CatchableError as e:
cljVector(@[cljString("error: " & e.msg)])
proc cljFileExists*(path: CljVal): CljVal =
if path.kind != ckString:
return cljBool(false)
cljBool(fileExists(path.strVal))
# ---- Git Operations ----
proc cljGitStatus*(): CljVal =
let (branchOut, _) = execCmdEx("git rev-parse --abbrev-ref HEAD")
let branch = branchOut.strip()
let (statusOut, _) = execCmdEx("git status --porcelain")
var modified: seq[CljVal] = @[]
var untracked: seq[CljVal] = @[]
var staged: seq[CljVal] = @[]
for line in statusOut.splitLines():
if line.len < 3: continue
let status = line[0..1]
let file = line[3..^1]
if status[0] != ' ' and status[0] != '?':
staged.add(cljString(file))
if status[1] != ' ':
modified.add(cljString(file))
if status == "??":
untracked.add(cljString(file))
let clean = modified.len == 0 and untracked.len == 0 and staged.len == 0
cljMapFromPairs(@[
(cljKeyword("branch"), cljString(branch)),
(cljKeyword("modified"), cljVector(modified)),
(cljKeyword("untracked"), cljVector(untracked)),
(cljKeyword("staged"), cljVector(staged)),
(cljKeyword("clean"), cljBool(clean))
])
proc cljGitCommit*(msg: CljVal): CljVal =
if msg.kind != ckString:
return cljMapFromPairs(@[(cljKeyword("error"), cljString("git/commit requires a string message"))])
let (gitOut, exit) = execCmdEx("git add -A && git commit -m " & quoteShell(msg.strVal))
if exit != 0:
return cljMapFromPairs(@[(cljKeyword("error"), cljString(gitOut)), (cljKeyword("success"), cljBool(false))])
var sha = ""
let (shaOut, _) = execCmdEx("git rev-parse --short HEAD")
sha = shaOut.strip()
cljMapFromPairs(@[
(cljKeyword("sha"), cljString(sha)),
(cljKeyword("success"), cljBool(true))
])
proc cljGitPush*(): CljVal =
let (gitOut, exit) = execCmdEx("git push")
cljMapFromPairs(@[
(cljKeyword("success"), cljBool(exit == 0)),
(cljKeyword("output"), cljString(gitOut.strip()))
])
proc cljGitDiff*(): CljVal =
let (gitOut, _) = execCmdEx("git diff")
cljString(gitOut)
proc cljGitLog*(n: CljVal = cljInt(5)): CljVal =
let count = if n.kind == ckInt: n.intVal else: 5
let (gitOut, _) = execCmdEx("git log --oneline -" & $count)
var items: seq[CljVal] = @[]
for line in gitOut.splitLines():
if line.len > 0:
items.add(cljString(line))
cljVector(items)