ocaml/reader.ml

   1 module T = Types.Types
   2         (* ^file ^module *)
   3
   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
  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)
  14       (Str.full_split re str))
  15
  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
  21 let token_re = (Str.regexp "~@\\|[][{}()'`~^@]\\|\"\\(\\\\.\\|[^\"]\\)*\"\\|;.*\\|[^][  \n{}('\"`,;)]*")
  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
  35     | "nil" -> T.Nil
  36     | "true" -> T.Bool true
  37     | "false" -> T.Bool false
  38     | _ ->
  39     match token.[0] with
  40       | '0'..'9' -> T.Int (int_of_string token)
  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))
  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)))
  51       | ':' -> T.Keyword (Str.replace_first (Str.regexp "^:") "" token)
  52       | _ -> Types.symbol token
  53
  54 let with_meta obj meta =
  55   match obj with
  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 };
  62     | _ -> raise (Invalid_argument "metadata not supported on this type")
  63
  64 let rec read_list eol list_reader =
  65   match list_reader.tokens with
  66     | [] -> output_string stderr ("expected '" ^ eol ^ "', got EOF\n");
  67             flush stderr;
  68             raise End_of_file;
  69     | token :: tokens ->
  70       if Str.string_match (Str.regexp eol) token 0 then
  71         {list_form = list_reader.list_form; tokens = tokens}
  72       else if token.[0] = ';' then
  73         read_list eol { list_form = list_reader.list_form;
  74                         tokens = tokens }
  75       else
  76         let reader = read_form list_reader.tokens in
  77           read_list eol {list_form = list_reader.list_form @ [reader.form];
  78                          tokens = reader.tokens}
  79 and read_quote sym tokens =
  80   let reader = read_form tokens in
  81     {form = Types.list [ Types.symbol sym; reader.form ];
  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
  88         | "'"  -> read_quote "quote" tokens
  89         | "`"  -> read_quote "quasiquote" tokens
  90         | "~"  -> read_quote "unquote" tokens
  91         | "~@" -> read_quote "splice-unquote" tokens
  92         | "@"  -> read_quote "deref" tokens
  93         | "^"  ->
  94            let meta = read_form tokens in
  95            let value = read_form meta.tokens in
  96              {(*form = with_meta value.form meta.form;*)
  97               form = Types.list [Types.symbol "with-meta"; value.form; meta.form];
  98               tokens = value.tokens}
  99         | "(" ->
 100            let list_reader = read_list ")" {list_form = []; tokens = tokens} in
 101              {form = Types.list list_reader.list_form;
 102               tokens = list_reader.tokens}
 103         | "{" ->
 104            let list_reader = read_list "}" {list_form = []; tokens = tokens} in
 105              {form = Types.list_into_map Types.MalMap.empty list_reader.list_form;
 106               tokens = list_reader.tokens}
 107         | "[" ->
 108            let list_reader = read_list "]" {list_form = []; tokens = tokens} in
 109              {form = Types.vector list_reader.list_form;
 110               tokens = list_reader.tokens}
 111         | _ -> if token.[0] = ';'
 112                then read_form tokens
 113                else {form = read_atom token; tokens = tokens}
 114
 115 let read_str str = (read_form (List.filter ((<>) "") (find_re token_re str))).form
 116