blob: 1cb41bfb389e5cf2182a8ab8037f9c2b4ea27c68 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
#lang racket
(provide core_ns)
(require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt")
(define (throw exc)
(raise (make-mal-exn "mal exception"
(current-continuation-marks)
exc)))
;; Sequence functions
(define conj
(lambda a
(if (vector? (first a))
(vector-append (first a) (list->vector (rest a)))
(append (reverse (rest a)) (first a)))))
;; Meta functions
(define (meta obj)
(cond [(malfunc? obj) (malfunc-meta obj)]
[else nil]))
(define (with-meta obj m)
(cond [(malfunc? obj) (struct-copy malfunc obj [meta m])]
[else (raise "metadata not supported on type")]))
;; Atom functions
(define swap!
(lambda a
(let* ([atm (first a)]
[f (second a)]
[args (cons (atom-val atm) (rest (rest a)))]
[val (apply f args)])
(set-atom-val! atm val)
val)))
(define core_ns
(hash
'= _equal?
'throw throw
'nil? _nil?
'true? (lambda (x) (eq? x #t))
'false? (lambda (x) (eq? x #f))
'symbol (lambda (s) (if (symbol? s) s (string->symbol s)))
'symbol? symbol?
'keyword (lambda (s) (if (_keyword? s) s (_keyword s)))
'keyword? _keyword?
'pr-str (lambda a (pr_lst a #t " "))
'str (lambda a (pr_lst a #f ""))
'prn (lambda a (printf "~a~n" (pr_lst a #t " ")) nil)
'println (lambda a (printf "~a~n" (pr_lst a #f " ")) nil)
'read-string (lambda (s) (read_str s))
'readline readline
'slurp (lambda (f) (port->string (open-input-file f)))
'< <
'<= <=
'> >
'>= >=
'+ +
'- -
'* *
'/ /
'time-ms (lambda () (round (current-inexact-milliseconds)))
'list list
'list? list?
'vector vector
'vector? vector?
'hash-map hash
'map? hash?
'assoc _assoc
'dissoc _dissoc
'get _get
'contains? dict-has-key?
'keys hash-keys
'vals hash-values
'sequential? _sequential?
'cons (lambda a (cons (first a) (_to_list (second a))))
'concat (lambda a (apply append (map _to_list a)))
'nth _nth
'first _first
'rest _rest
'empty? _empty?
'count _count
'apply apply
'map (lambda (f s) (_to_list (_map f s)))
'conj conj
'meta meta
'with-meta with-meta
'atom atom
'atom? atom?
'deref (lambda (a) (atom-val a))
'reset! (lambda (a v) (set-atom-val! a v) v)
'swap! swap!))
|
