Skip to content
Newer
Older
100644 69 lines (60 sloc) 2.52 KB
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 module B = Base
19 let (<|) f a = f a
20 let (|>) a f = f a
21 let ( @* ) g f x = g(f(x))
22 module O = Ocaml
23 module Cons = O.Cons
24 module G = Grammar
25 module T = Tools
26 module L = B.List
27 module A = B.Array
28 module S = B.String
29
30 let tostr v ts_opt t_opt =
31 match ts_opt, t_opt with
32 | (Some (_,ts),_) -> "("^ts^" "^v^")"
33 | (_,None) -> v
34 | (_,Some (O.TypeConst O.TypeUnit)) -> "((fun () -> \"()\") "^v^")"
35 | (_,Some (O.TypeConst O.TypeBool)) -> "(string_of_bool "^v^")"
36 | (_,Some (O.TypeConst O.TypeInt)) -> "(string_of_int "^v^")"
37 | (_,Some (O.TypeConst O.TypeInt64)) -> "(Int64.to_string "^v^")"
38 | (_,Some (O.TypeName (_,["int64"]))) -> "(Int64.to_string "^v^")"
39 | (_,Some (O.TypeConst O.TypeFloat)) -> "(string_of_float "^v^")"
40 | (_,Some (O.TypeConst O.TypeString)) -> v
41 | (_,Some (O.TypeName ([O.TypeConst O.TypeString], ["list"]))) -> "(String.concat \" \" "^v^")"
42 | (_,Some t) ->
43 OcamlPrint.Output.type_expr stderr t; prerr_newline (); flush stderr;
44 failwith "Can't convert such a type to string."
45
46 let cats s1 s2 =
47 match (s1,s2) with
48 | s1,"" -> s1
49 | s1,"\"\"" -> s1
50 | "",s2 -> s2
51 | "\"\"",s2 -> s2
52 | s1,s2 -> s1^"^"^s2
53
54 let pattern_of_raw = function
55 | G.Raw (name, (pre1,opts), lst) ->
56 let vlist = L.map (fun (v,_,_,_) -> v) lst in
57 let pvlist = L.map (fun v -> O.PatVar (Ident.source v)) vlist in
58 let dostr = function Some (l,_) -> l | None -> "" in
59 let verbatim = cats pre1 (L.fold_left (fun s (v,t_opt,l_opt,ts_opt) ->
60 cats (cats s (tostr v ts_opt t_opt)) (dostr l_opt)) "" lst) in
61 O.PatConstructor ([Ident.source name], pvlist), O.Verbatim verbatim
62 | _ -> assert false
63
64 (* Some conversion functions. *)
65 let do_it lst =
66 let tuple_list = L.map pattern_of_raw lst in
67 let func = O.Function (L.map (fun (a, b) -> a, None, b) tuple_list) in
68 O.Let [O.Pat (O.PatVar (Ident.source "string_of_rawmsg")), func]
Something went wrong with that request. Please try again.