Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 89 lines (70 sloc) 2.414 kb
fccc685 Initial open-source release
MLstate authored
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 Q = QmlAst
19
20 exception Bad_structure
21
22
23 (* assert false are forbidden !!! *)
24
25 let of_coerce = function
26 | Q.Coerce (_, e, t) -> e, t
27 | _ -> raise Bad_structure
28
29 let rec of_couple e = match e with
30 | Q.Record (_, [("f1", e1); ("f2", e2) ]) -> (e1, e2)
31 | _ -> of_couple (fst (of_coerce e) )
32
33 let is f e =
34 try let _ = f e in true
35 with Bad_structure -> false
36
37 let is_couple e = is of_couple e
38
39
40 module Pat =
41 struct
42 type 'a util = Q.pat -> 'a
43
44 let void_coerce ty =
45 match ty with
46 | Q.TypeName ([], ty) when let id = Q.TypeIdent.to_string ty in id = "void" || id = "unit" -> true
47 | Q.TypeRecord (Q.TyRow ([], None)) -> true
48 | _ -> false
49
50 let bool_coerce ty =
51 match ty with
52 | Q.TypeName ([], ty) when Q.TypeIdent.to_string ty = "bool" -> true
53 | _ -> false
54
55 let is_void = function
56 | Q.PatRecord (_, [], `closed) -> true
57 | Q.PatCoerce (_, Q.PatRecord (_, [], _), ty) -> void_coerce ty
58 | _ -> false
59
60 let rec is_bool = function
61 | Q.PatCoerce (_, pat, ty) -> if bool_coerce ty then is_bool pat else None
62 | Q.PatRecord (_, [bool, void], `closed) ->
63 if is_void void
64 then (
65 match bool with
66 | "true" -> Some true
67 | "false" -> Some false
68 | _ -> None
69 )
70 else None
71 | _ -> None
72 end
73
74 let uncons_ifthenelse if_ pats =
75 match pats with
76 | [ true_, then_ ; false_, else_ ] -> (
77 if (Pat.is_bool true_) = (Some true) && (Pat.is_bool false_) = (Some false)
78 then (
79 match if_ with
80 | Q.Coerce (_, if_, ty) ->
81 if Pat.bool_coerce ty
82 then Some (if_, then_, else_)
83 else None
84 | _ -> Some (if_, then_, else_)
85 )
86 else None
87 )
88 | _ -> None
Something went wrong with that request. Please try again.