io/MalCore.io

   1 MalCore := Object clone do(
   2     slurp := block(a,
   3         f := File with(a at(0))
   4         res := f contents
   5         f close
   6         res
   7     )
   8
   9     dissoc := block(a,
  10         res := MalMap withMap(a at(0))
  11         a rest foreach(k, res removeKey(k))
  12         res
  13     )
  14
  15     nth := block(a,
  16         if(a at(1) < a at(0) size,
  17             a at(0) at(a at(1)),
  18             Exception raise("nth: index out of range")
  19         )
  20     )
  21
  22     conj := block(a,
  23         coll := a at(0)
  24         coll type switch(
  25             "MalList",
  26                 MalList with(a rest reverse appendSeq(coll)),
  27             "MalVector",
  28                 MalVector with(coll appendSeq(a rest))
  29         )
  30     )
  31
  32     seq := block(a,
  33         obj := a at(0)
  34         (obj isNil) ifTrue(return(nil))
  35         (obj type == "MalList") ifTrue(return(if(obj isEmpty, nil, obj)))
  36         (obj type == "MalVector") ifTrue(return(if(obj isEmpty, nil, MalList with(obj))))
  37         (obj type == "Sequence") ifTrue(
  38             if(obj isEmpty, return(nil))
  39             lst := list()
  40             obj foreach(i, c, lst append(obj inclusiveSlice(i, i)))
  41             return(MalList with(lst))
  42         )
  43         nil
  44     )
  45
  46     swapBang := block(a,
  47         atom := a at(0)
  48         newVal := a at(1) call(MalList with(list(atom val)) appendSeq(a slice(2)))
  49         atom setVal(newVal) val
  50     )
  51
  52     ioToMal := method(v,
  53         (v isNil) ifTrue(return(v))
  54         (v == true) ifTrue(return(v))
  55         (v == false) ifTrue(return(v))
  56         (v type == "Number") ifTrue(return(v))
  57         (v type == "Sequence") ifTrue(return(v))
  58         (v type == "List") ifTrue(return(MalList with(v map(e, ioToMal(e)))))
  59         (v type == "Map") ifTrue(
  60             lst := list()
  61             v foreach(key, val,
  62                 lst push(key asString)
  63                 lst push(ioToMal(val))
  64             )
  65             return(MalMap withList(lst))
  66         )
  67         v asString
  68     )
  69
  70     ioEval := block(a,
  71         MalCore ioToMal(doString(a at(0)))
  72     )
  73
  74     NS := Map with(
  75         "=",     block(a, a at(0) == a at(1)),
  76         "throw", block(a, MalException with(a at(0)) raise),
  77
  78         "nil?",     block(a, a at(0) isNil),
  79         "true?",    block(a, a at(0) == true),
  80         "false?",   block(a, a at(0) == false),
  81         "string?",  block(a, a at(0) type == "Sequence"),
  82         "symbol",   block(a, MalSymbol with(a at(0))),
  83         "symbol?",  block(a, a at(0) type == "MalSymbol"),
  84         "keyword",  block(a, MalKeyword with(a at(0))),
  85         "keyword?", block(a, a at(0) type == "MalKeyword"),
  86         "number?",  block(a, a at(0) type == "Number"),
  87         "fn?",      block(a, (a at(0) type == "Block") or
  88                              ((a at(0) type == "MalFunc") and (a at(0) isMacro not))),
  89         "macro?",   block(a, (a at(0) type == "MalFunc") and (a at(0) isMacro)),
  90
  91         "pr-str",  block(a, a map(s, s malPrint(true)) join(" ")),
  92         "str",     block(a, a map(s, s malPrint(false)) join("")),
  93         "prn",     block(a, a map(s, s malPrint(true)) join(" ") println ; nil),
  94         "println", block(a, a map(s, s malPrint(false)) join(" ") println ; nil),
  95         "read-string", block(a, MalReader read_str(a at(0))),
  96         "readline",    block(a, MalReadline readLine(a at(0))),
  97         "slurp",   slurp,
  98
  99         "<",  block(a, a at(0) <  a at(1)),
 100         "<=", block(a, a at(0) <= a at(1)),
 101         ">",  block(a, a at(0) >  a at(1)),
 102         ">=", block(a, a at(0) >= a at(1)),
 103         "+",  block(a, a at(0) +  a at(1)),
 104         "-",  block(a, a at(0) -  a at(1)),
 105         "*",  block(a, a at(0) *  a at(1)),
 106         "/",  block(a, a at(0) /  a at(1)),
 107         "time-ms", block(a, (Date now asNumber * 1000.0) round),
 108
 109         "list",      block(a, a),
 110         "list?",     block(a, a at(0) type == "MalList"),
 111         "vector",    block(a, MalVector with(a)),
 112         "vector?",   block(a, a at(0) type == "MalVector"),
 113         "hash-map",  block(a, MalMap withList(a)),
 114         "map?",      block(a, a at(0) type == "MalMap"),
 115         "assoc",     block(a, MalMap withMap(a at(0) merge(MalMap withList(a rest)))),
 116         "dissoc",    dissoc,
 117         "get",       block(a, a at(0) ifNil(return nil) get(a at(1))),
 118         "contains?", block(a, a at(0) ifNil(return nil) contains(a at(1))),
 119         "keys",      block(a, a at(0) malKeys),
 120         "vals",      block(a, a at(0) malVals),
 121
 122         "sequential?", block(a, if(a at(0) ?isSequential, true, false)),
 123         "cons",   block(a, MalList with(list(a at(0)) appendSeq(a at(1)))),
 124         "concat", block(a, MalList with(a reduce(appendSeq, list()))),
 125         "nth",    nth,
 126         "first",  block(a, a at(0) ifNil(return nil) first),
 127         "rest",   block(a, a at(0) ifNil(return MalList with(list())) rest),
 128         "empty?", block(a, a at(0) ifNil(true) isEmpty),
 129         "count",  block(a, a at(0) ifNil(return(0)) size),
 130         "apply",  block(a, a at(0) call(MalList with(a slice(1, -1) appendSeq(a last)))),
 131         "map",    block(a, MalList with(a at(1) map(e, a at(0) call(MalList with(list(e)))))),
 132
 133         "conj",   conj,
 134         "seq",    seq,
 135
 136         "meta",      block(a, a at(0) ?meta),
 137         "with-meta", block(a, a at(0) clone setMeta(a at(1))),
 138         "atom",      block(a, MalAtom with(a at(0))),
 139         "atom?",     block(a, a at(0) type == "MalAtom"),
 140         "deref",     block(a, a at(0) val),
 141         "reset!",    block(a, a at(0) setVal(a at(1)) ; a at(1)),
 142         "swap!",     swapBang,
 143
 144         "io-eval",   ioEval
 145     )
 146 )