import cljnim_pvec import cljnim_pmap import strutils, sequtils, hashes, algorithm, os, osproc, locks type CljKind* = enum ckNil, ckBool, ckInt, ckFloat, ckString, ckKeyword, ckSymbol, ckList, ckVector, ckMap, ckSet, ckFn, ckAtom, ckTransient, ckAgent AgentAction = object fn: CljVal args: seq[CljVal] CljVal* = ref CljValObj CljValObj = object meta*: CljVal 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*: PersistentVector[CljVal] of ckMap: mapData*: PersistentMap[CljVal, CljVal] of ckSet: setData*: PersistentMap[CljVal, bool] of ckFn: fnProc*: proc(args: seq[CljVal]): CljVal of ckAtom: atomVal*: CljVal of ckTransient: transKind*: CljKind transVec*: seq[CljVal] transPairs*: seq[(CljVal, CljVal)] of ckAgent: agentVal*: CljVal agentLock*: Lock agentQueue*: seq[AgentAction] agentBusy*: bool # ---- Hashing ---- proc hash*(v: CljVal): Hash = case v.kind of ckNil: result = hash(0) of ckBool: result = hash(v.boolVal) of ckInt: result = hash(v.intVal) of ckFloat: result = hash(v.floatVal) of ckString: result = hash(v.strVal) of ckKeyword: result = hash(v.kwName) of ckSymbol: result = hash(v.symName) of ckFn: result = hash(cast[uint](unsafeAddr v.fnProc)) of ckAtom: result = hash(cast[uint](unsafeAddr v.atomVal)) of ckAgent: result = hash(cast[uint](unsafeAddr v.agentVal)) of ckList, ckVector, ckMap, ckSet, ckTransient: result = hash(0) # ---- 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 proc cljEq*(a, b: CljVal): bool = a == b # ---- 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: newPersistentVector(items)) proc cljFn*(p: proc(args: seq[CljVal]): CljVal): CljVal = CljVal(kind: ckFn, fnProc: p) proc cljMap*(keys, vals: seq[CljVal]): CljVal = var m = newPersistentMap[CljVal, CljVal]() for i in 0.." of ckAtom: "(atom " & cljRepr(v.atomVal) & ")" of ckTransient: "#" of ckAgent: "(agent " & cljRepr(v.agentVal) & ")" 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) proc cljIsNilP*(v: CljVal): CljVal = cljBool(cljIsNil(v)) proc cljIsSome*(v: CljVal): CljVal = cljBool(not cljIsNil(v)) proc cljIsKeyword*(v: CljVal): CljVal = cljBool(not cljIsNil(v) and v.kind == ckKeyword) proc cljIsSymbol*(v: CljVal): CljVal = cljBool(not cljIsNil(v) and v.kind == ckSymbol) proc cljIsString*(v: CljVal): CljVal = cljBool(not cljIsNil(v) and v.kind == ckString) proc cljIsNumber*(v: CljVal): CljVal = cljBool(not cljIsNil(v) and (v.kind == ckInt or v.kind == ckFloat)) proc cljIsInteger*(v: CljVal): CljVal = cljBool(not cljIsNil(v) and v.kind == ckInt) proc cljIsFloat*(v: CljVal): CljVal = cljBool(not cljIsNil(v) and v.kind == ckFloat) proc cljIsVector*(v: CljVal): CljVal = cljBool(not cljIsNil(v) and v.kind == ckVector) proc cljIsMap*(v: CljVal): CljVal = cljBool(not cljIsNil(v) and v.kind == ckMap) proc cljIsSet*(v: CljVal): CljVal = cljBool(not cljIsNil(v) and v.kind == ckSet) proc cljIsList*(v: CljVal): CljVal = cljBool(not cljIsNil(v) and v.kind == ckList) proc cljIsSeq*(v: CljVal): CljVal = cljBool(not cljIsNil(v) and v.kind in {ckList, ckVector}) proc cljIsColl*(v: CljVal): CljVal = cljBool(not cljIsNil(v) and v.kind in {ckList, ckVector, ckMap, ckSet}) proc cljIsSequential*(v: CljVal): CljVal = cljBool(not cljIsNil(v) and v.kind in {ckList, ckVector}) proc cljIsFn*(v: CljVal): CljVal = cljBool(not cljIsNil(v) and v.kind == ckFn) proc cljIsBool*(v: CljVal): CljVal = cljBool(not cljIsNil(v) and v.kind == ckBool) proc cljIsTrueP*(v: CljVal): CljVal = cljBool(cljIsTrue(v)) proc cljIsFalseP*(v: CljVal): CljVal = cljBool(cljIsFalse(v)) proc cljKeywordFn*(v: CljVal): CljVal = if v.isNil or v.kind == ckNil: return cljNil() case v.kind of ckKeyword: v of ckString: cljKeyword(v.strVal) of ckSymbol: cljKeyword(v.symName) else: cljNil() proc cljSymbolFn*(v: CljVal): CljVal = if v.isNil or v.kind == ckNil: return cljNil() case v.kind of ckSymbol: v of ckString: cljSymbol(v.strVal) of ckKeyword: cljSymbol(v.kwName) else: cljNil() proc cljName*(v: CljVal): CljVal = if v.isNil or v.kind == ckNil: return cljNil() case v.kind of ckKeyword: cljString(v.kwName) of ckSymbol: cljString(v.symName) else: raise newException(CatchableError, "name requires a keyword or symbol") proc cljNamespace*(v: CljVal): CljVal = if v.isNil or v.kind == ckNil: return cljNil() case v.kind of ckKeyword: let idx = v.kwName.find('/') if idx >= 0: cljString(v.kwName[0..= 0: cljString(v.symName[0..= 2: pvecNth(v.vecData, 0) else: cljNil() of ckList: if v.listItems.len >= 2: v.listItems[0] else: cljNil() else: raise newException(CatchableError, "key requires a map entry (vector or list of 2 items)") proc cljEntryVal*(v: CljVal): CljVal = if v.isNil or v.kind == ckNil: return cljNil() case v.kind of ckVector: if v.vecData.count >= 2: pvecNth(v.vecData, 1) else: cljNil() of ckList: if v.listItems.len >= 2: v.listItems[1] else: cljNil() else: raise newException(CatchableError, "val requires a map entry (vector or list of 2 items)") # ---- 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.. result.intVal: result = args[i] proc cljQuot*(a, b: CljVal): CljVal = if a.kind == ckInt and b.kind == ckInt: if b.intVal == 0: raise newException(CatchableError, "Division by zero") cljInt(a.intVal div b.intVal) else: raise newException(CatchableError, "quot requires integers") proc cljRem*(a, b: CljVal): CljVal = if a.kind == ckInt and b.kind == ckInt: if b.intVal == 0: raise newException(CatchableError, "Division by zero") cljInt(a.intVal mod b.intVal) else: raise newException(CatchableError, "rem requires integers") # ---- Comparison ---- proc cljNumEq*(args: seq[CljVal]): CljVal = if args.len < 2: return cljBool(true) for i in 1..= 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.. 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.. 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): CljVal = if v.isNil: return cljInt(0) case v.kind of ckList: cljInt(v.listItems.len) of ckVector: cljInt(v.vecData.count) of ckMap: cljInt(v.mapData.count) of ckSet: cljInt(v.setData.count) of ckString: cljInt(v.strVal.len) of ckTransient: if v.transKind == ckVector: cljInt(v.transVec.len) else: cljInt(v.transPairs.len) else: cljInt(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.count == 0: cljNil() else: pvecNth(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.count <= 1: cljList(@[]) else: cljList(toSeq(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 cljSecond*(v: CljVal): CljVal = cljFirst(cljRest(v)) proc cljFfirst*(v: CljVal): CljVal = cljFirst(cljFirst(v)) proc cljNfirst*(v: CljVal): CljVal = cljNext(cljFirst(v)) 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.count == 0: cljNil() else: pvecNth(v.vecData, v.vecData.count - 1) else: cljNil() proc cljNth*(v: CljVal, n: CljVal): CljVal = let idx = n.intVal case v.kind of ckList: if idx < 0 or idx >= v.listItems.len: raise newException(IndexDefect, "nth: index out of range") v.listItems[idx] of ckVector: if idx < 0 or idx >= v.vecData.count: raise newException(IndexDefect, "nth: index out of range") pvecNth(v.vecData, idx) 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 = toSeq(coll.vecData) newItems.add(item) cljVector(newItems) of ckSet: CljVal(kind: ckSet, setData: pmapAssoc(coll.setData, item, true, hash(item), cljEq)) 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(toSeq(coll.vecData)) cljList(newItems) else: cljList(@[item]) proc cljDisj*(s: CljVal, item: CljVal): CljVal = if s.isNil or s.kind != ckSet: return cljSet(@[]) CljVal(kind: ckSet, setData: pmapDissoc(s.setData, item, hash(item), cljEq)) proc cljPeek*(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.count == 0: cljNil() else: pvecNth(v.vecData, v.vecData.count - 1) else: cljNil() proc cljPop*(v: CljVal): CljVal = if v.isNil: return cljNil() case v.kind of ckList: if v.listItems.len <= 1: cljList(@[]) else: cljList(v.listItems[1..^1]) of ckVector: if v.vecData.count <= 1: cljVector(@[]) else: var items = toSeq(v.vecData) items.setLen(items.len - 1) cljVector(items) else: cljNil() 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.count == 0: cljNil() else: cljList(toSeq(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) of ckSet: if v.setData.count == 0: cljNil() else: cljList(pmapKeys(v.setData)) 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).intVal == 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(toSeq(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..= 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.. empty vector (unbuffered) # (chan n) -> vector with capacity marker cljVector(@[]) proc cljChanClose*(ch: CljVal): CljVal = cljNil() # ---- Transients ---- proc cljTransient*(coll: CljVal): CljVal = case coll.kind of ckVector: result = CljVal(kind: ckTransient, transKind: ckVector) result.transVec = toSeq(coll.vecData) of ckMap: result = CljVal(kind: ckTransient, transKind: ckMap) result.transPairs = pmapEntries(coll.mapData) of ckSet: result = CljVal(kind: ckTransient, transKind: ckVector) result.transVec = pmapKeys(coll.setData) else: raise newException(CatchableError, "transient requires a collection") proc cljPersistent*(t: CljVal): CljVal = if t.isNil or t.kind != ckTransient: raise newException(CatchableError, "persistent! requires a transient") case t.transKind of ckVector: cljVector(t.transVec) of ckMap: var m = newPersistentMap[CljVal, CljVal]() for (k, v) in t.transPairs: m = pmapAssoc(m, k, v, hash(k), cljEq) CljVal(kind: ckMap, mapData: m) else: raise newException(CatchableError, "persistent! requires a transient") proc cljConjB*(t: CljVal, item: CljVal): CljVal = if t.isNil or t.kind != ckTransient: raise newException(CatchableError, "conj! requires a transient") case t.transKind of ckVector: t.transVec.add(item) of ckMap: if item.kind == ckVector and item.vecData.count == 2: t.transPairs.add((pvecNth(item.vecData, 0), pvecNth(item.vecData, 1))) of ckSet: discard else: raise newException(CatchableError, "conj! unsupported source type") t proc cljAssocB*(t: CljVal, key: CljVal, val: CljVal): CljVal = if t.isNil or t.kind != ckTransient: raise newException(CatchableError, "assoc! requires a transient") if t.transKind == ckMap: t.transPairs.add((key, val)) t # ---- Additional functions needed by emitter ---- proc cljNotEq*(args: seq[CljVal]): CljVal = cljNot(cljMultiEqual(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 = toSeq(to.vecData) items.add(src.listItems) cljVector(items) of ckVector: var items = toSeq(to.vecData) items.add(toSeq(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(toSeq(src.vecData)) cljList(items) else: to of ckMap: if src.kind == ckMap: var res = to.mapData for (k, v) in pmapItems(src.mapData): res = pmapAssoc(res, k, v, hash(k), cljEq) CljVal(kind: ckMap, mapData: res) elif src.kind == ckVector: var res = to.mapData for pair in src.vecData.items: if pair.kind == ckVector and pair.vecData.count == 2: res = pmapAssoc(res, pvecNth(pair.vecData, 0), pvecNth(pair.vecData, 1), hash(pvecNth(pair.vecData, 0)), cljEq) CljVal(kind: ckMap, mapData: res) elif src.kind == ckList: var res = to.mapData for pair in src.listItems: if pair.kind == ckVector and pair.vecData.count == 2: res = pmapAssoc(res, pvecNth(pair.vecData, 0), pvecNth(pair.vecData, 1), hash(pvecNth(pair.vecData, 0)), cljEq) CljVal(kind: ckMap, mapData: res) 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.. 0: var i = start.intVal while i < finish.intVal: items.add(cljInt(i)) i += step.intVal else: var i = start.intVal while i > finish.intVal: items.add(cljInt(i)) i += step.intVal cljList(items) proc cljRepeat*(n: CljVal, x: CljVal): CljVal = if n.kind != ckInt: raise newException(CatchableError, "repeat requires an integer count") var items: seq[CljVal] = @[] for i in 0.. 0: items.add(cljString(line)) proc cljZipmap*(args: seq[CljVal]): CljVal = if args.len < 2: raise newException(CatchableError, "zipmap requires 2 arguments") let keys = args[0] let vals = args[1] if keys.kind != ckVector and keys.kind != ckList: raise newException(CatchableError, "zipmap: first argument must be seqable") var kitems: seq[CljVal] = @[] var vitems: seq[CljVal] = @[] case keys.kind of ckVector: kitems = keys.vecData.toSeq() of ckList: kitems = keys.listItems else: discard case vals.kind of ckVector: vitems = vals.vecData.toSeq() of ckList: vitems = vals.listItems else: discard var mk: seq[CljVal] = @[] var mv: seq[CljVal] = @[] let n = min(kitems.len, vitems.len) for i in 0..