blob: 7456cf8e1c6fbf4c994a1d46d96d0e51547dc5cd (
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
102
103
104
105
106
107
108
109
110
111
|
module T = Types.Types
(* ^file ^module *)
let slurp filename =
let chan = open_in filename in
let b = Buffer.create 27 in
Buffer.add_channel b chan (in_channel_length chan) ;
close_in chan ;
Buffer.contents b
let find_re re str =
List.map (function | Str.Delim x -> x | Str.Text x -> "impossible!")
(List.filter (function | Str.Delim x -> true | Str.Text x -> false)
(Str.full_split re str))
let gsub re f str =
String.concat
"" (List.map (function | Str.Delim x -> f x | Str.Text x -> x)
(Str.full_split re str))
let token_re = (Str.regexp "~@\\|[][{}()'`~^@]\\|\"\\(\\\\.\\|[^\"]\\)*\"\\|;.*\\|[^][ \n{}('\"`,;)]*")
type reader = {
form : Types.mal_type;
tokens : string list;
}
type list_reader = {
list_form : Types.mal_type list;
tokens : string list;
}
let read_atom token =
match token with
| "nil" -> T.Nil
| "true" -> T.Bool true
| "false" -> T.Bool false
| _ ->
match token.[0] with
| '0'..'9' -> T.Int (int_of_string token)
| '"' -> T.String (gsub (Str.regexp "\\\\.")
(function
| "\\n" -> "\n"
| x -> String.sub x 1 1)
(String.sub token 1 ((String.length token) - 2)))
| ':' -> T.Keyword (Str.replace_first (Str.regexp "^:") "" token)
| _ -> Types.symbol token
let with_meta obj meta =
match obj with
| T.List { T.value = v }
-> T.List { T.value = v; T.meta = meta }; | T.Map { T.value = v }
-> T.Map { T.value = v; T.meta = meta }; | T.Vector { T.value = v }
-> T.Vector { T.value = v; T.meta = meta }; | T.Symbol { T.value = v }
-> T.Symbol { T.value = v; T.meta = meta }; | T.Fn { T.value = v }
-> T.Fn { T.value = v; T.meta = meta };
| _ -> raise (Invalid_argument "metadata not supported on this type")
let rec read_list eol list_reader =
match list_reader.tokens with
| [] -> output_string stderr ("expected '" ^ eol ^ "', got EOF\n");
flush stderr;
raise End_of_file;
| token :: tokens ->
if Str.string_match (Str.regexp eol) token 0 then
{list_form = list_reader.list_form; tokens = tokens}
else if token.[0] = ';' then
read_list eol { list_form = list_reader.list_form;
tokens = tokens }
else
let reader = read_form list_reader.tokens in
read_list eol {list_form = list_reader.list_form @ [reader.form];
tokens = reader.tokens}
and read_quote sym tokens =
let reader = read_form tokens in
{form = Types.list [ Types.symbol sym; reader.form ];
tokens = reader.tokens}
and read_form all_tokens =
match all_tokens with
| [] -> raise End_of_file;
| token :: tokens ->
match token with
| "'" -> read_quote "quote" tokens
| "`" -> read_quote "quasiquote" tokens
| "~" -> read_quote "unquote" tokens
| "~@" -> read_quote "splice-unquote" tokens
| "@" -> read_quote "deref" tokens
| "^" ->
let meta = read_form tokens in
let value = read_form meta.tokens in
{(*form = with_meta value.form meta.form;*)
form = Types.list [Types.symbol "with-meta"; value.form; meta.form];
tokens = value.tokens}
| "(" ->
let list_reader = read_list ")" {list_form = []; tokens = tokens} in
{form = Types.list list_reader.list_form;
tokens = list_reader.tokens}
| "{" ->
let list_reader = read_list "}" {list_form = []; tokens = tokens} in
{form = Types.list_into_map Types.MalMap.empty list_reader.list_form;
tokens = list_reader.tokens}
| "[" ->
let list_reader = read_list "]" {list_form = []; tokens = tokens} in
{form = Types.vector list_reader.list_form;
tokens = list_reader.tokens}
| _ -> if token.[0] = ';'
then read_form tokens
else {form = read_atom token; tokens = tokens}
let read_str str = (read_form (List.filter ((<>) "") (find_re token_re str))).form
|
