Commit | Line | Data |
---|---|---|
a878f3bb C |
1 | module T = Types.Types |
2 | (* ^file ^module *) | |
3 | ||
776cf577 C |
4 | let slurp filename = |
5 | let chan = open_in filename in | |
6 | let b = Buffer.create 27 in | |
7 | Buffer.add_channel b chan (in_channel_length chan) ; | |
8 | close_in chan ; | |
9 | Buffer.contents b | |
10 | ||
59d10e1b C |
11 | let find_re re str = |
12 | List.map (function | Str.Delim x -> x | Str.Text x -> "impossible!") | |
13 | (List.filter (function | Str.Delim x -> true | Str.Text x -> false) | |
776cf577 | 14 | (Str.full_split re str)) |
59d10e1b | 15 | |
16b17732 C |
16 | let gsub re f str = |
17 | String.concat | |
18 | "" (List.map (function | Str.Delim x -> f x | Str.Text x -> x) | |
19 | (Str.full_split re str)) | |
20 | ||
921a951f | 21 | let token_re = (Str.regexp "~@\\|[][{}()'`~^@]\\|\"\\(\\\\.\\|[^\"]\\)*\"\\|;.*\\|[^][ \n{}('\"`,;)]*") |
59d10e1b C |
22 | |
23 | type reader = { | |
24 | form : Types.mal_type; | |
25 | tokens : string list; | |
26 | } | |
27 | ||
28 | type list_reader = { | |
29 | list_form : Types.mal_type list; | |
30 | tokens : string list; | |
31 | } | |
32 | ||
33 | let read_atom token = | |
34 | match token with | |
a878f3bb C |
35 | | "nil" -> T.Nil |
36 | | "true" -> T.Bool true | |
37 | | "false" -> T.Bool false | |
59d10e1b C |
38 | | _ -> |
39 | match token.[0] with | |
a878f3bb | 40 | | '0'..'9' -> T.Int (int_of_string token) |
2c1eb1af DM |
41 | | '-' -> (match String.length token with |
42 | | 1 -> Types.symbol token | |
43 | | _ -> (match token.[1] with | |
44 | | '0'..'9' -> T.Int (int_of_string token) | |
45 | | _ -> Types.symbol token)) | |
16b17732 C |
46 | | '"' -> T.String (gsub (Str.regexp "\\\\.") |
47 | (function | |
48 | | "\\n" -> "\n" | |
49 | | x -> String.sub x 1 1) | |
50 | (String.sub token 1 ((String.length token) - 2))) | |
a878f3bb C |
51 | | ':' -> T.Keyword (Str.replace_first (Str.regexp "^:") "" token) |
52 | | _ -> Types.symbol token | |
59d10e1b | 53 | |
e64878d0 C |
54 | let with_meta obj meta = |
55 | match obj with | |
2b8e0ea4 C |
56 | | T.List { T.value = v } |
57 | -> T.List { T.value = v; T.meta = meta }; | T.Map { T.value = v } | |
58 | -> T.Map { T.value = v; T.meta = meta }; | T.Vector { T.value = v } | |
59 | -> T.Vector { T.value = v; T.meta = meta }; | T.Symbol { T.value = v } | |
60 | -> T.Symbol { T.value = v; T.meta = meta }; | T.Fn { T.value = v } | |
61 | -> T.Fn { T.value = v; T.meta = meta }; | |
e64878d0 C |
62 | | _ -> raise (Invalid_argument "metadata not supported on this type") |
63 | ||
387da0bb | 64 | let rec read_list eol list_reader = |
59d10e1b | 65 | match list_reader.tokens with |
387da0bb | 66 | | [] -> output_string stderr ("expected '" ^ eol ^ "', got EOF\n"); |
59d10e1b C |
67 | flush stderr; |
68 | raise End_of_file; | |
69 | | token :: tokens -> | |
387da0bb | 70 | if Str.string_match (Str.regexp eol) token 0 then |
921a951f | 71 | {list_form = list_reader.list_form; tokens = tokens} |
387da0bb C |
72 | else if token.[0] = ';' then |
73 | read_list eol { list_form = list_reader.list_form; | |
74 | tokens = tokens } | |
59d10e1b | 75 | else |
921a951f | 76 | let reader = read_form list_reader.tokens in |
387da0bb C |
77 | read_list eol {list_form = list_reader.list_form @ [reader.form]; |
78 | tokens = reader.tokens} | |
59d10e1b C |
79 | and read_quote sym tokens = |
80 | let reader = read_form tokens in | |
a878f3bb | 81 | {form = Types.list [ Types.symbol sym; reader.form ]; |
59d10e1b C |
82 | tokens = reader.tokens} |
83 | and read_form all_tokens = | |
84 | match all_tokens with | |
85 | | [] -> raise End_of_file; | |
86 | | token :: tokens -> | |
87 | match token with | |
921a951f C |
88 | | "'" -> read_quote "quote" tokens |
89 | | "`" -> read_quote "quasiquote" tokens | |
90 | | "~" -> read_quote "unquote" tokens | |
59d10e1b | 91 | | "~@" -> read_quote "splice-unquote" tokens |
a878f3bb | 92 | | "@" -> read_quote "deref" tokens |
e64878d0 C |
93 | | "^" -> |
94 | let meta = read_form tokens in | |
95 | let value = read_form meta.tokens in | |
04e33074 C |
96 | {(*form = with_meta value.form meta.form;*) |
97 | form = Types.list [Types.symbol "with-meta"; value.form; meta.form]; | |
98 | tokens = value.tokens} | |
e64878d0 | 99 | | "(" -> |
387da0bb | 100 | let list_reader = read_list ")" {list_form = []; tokens = tokens} in |
a878f3bb | 101 | {form = Types.list list_reader.list_form; |
921a951f | 102 | tokens = list_reader.tokens} |
e64878d0 | 103 | | "{" -> |
387da0bb | 104 | let list_reader = read_list "}" {list_form = []; tokens = tokens} in |
a878f3bb | 105 | {form = Types.list_into_map Types.MalMap.empty list_reader.list_form; |
b7ffcab9 | 106 | tokens = list_reader.tokens} |
e64878d0 | 107 | | "[" -> |
387da0bb | 108 | let list_reader = read_list "]" {list_form = []; tokens = tokens} in |
a878f3bb | 109 | {form = Types.vector list_reader.list_form; |
b7ffcab9 | 110 | tokens = list_reader.tokens} |
387da0bb C |
111 | | _ -> if token.[0] = ';' |
112 | then read_form tokens | |
113 | else {form = read_atom token; tokens = tokens} | |
59d10e1b C |
114 | |
115 | let read_str str = (read_form (List.filter ((<>) "") (find_re token_re str))).form | |
116 |