Permalink
Browse files

[enhance] compiler, qml: Use big_int for the node QmlAst.Int

  • Loading branch information...
1 parent 8bb47df commit 74bd3fddd585435491b757e81f95f660a071ff76 @BourgerieQuentin BourgerieQuentin committed Aug 8, 2012
@@ -29,5 +29,6 @@
<qmlEffects.ml>: with_mlstate_debug
<qmlMoreTypes.ml>: with_mlstate_debug
<qmlPatternAnalysis.ml>: with_mlstate_debug
+<qmlAstUtils.ml>: with_mlstate_debug
<qml2opa.{byte,native}>: thread, use_unix, use_ulex
@@ -408,18 +408,15 @@ let nolabel = Annot.nolabel "dbgen"
let expr_unit () = newexpr_annot (Q.Record (nolabel, [])) tyunit
let patt_unit () = newpatt_annot (Q.PatRecord (nolabel, [], `closed)) tyunit
-let const_int i = newexpr_annot (Q.Const (nolabel, (Q.Int i))) tyint
-let patt_const_int i = newpatt_annot (Q.PatConst (nolabel, (Q.Int i))) tyint
+let const_int i = newexpr_annot (Q.Const (nolabel, (Q.Int (Big_int.big_int_of_int i)))) tyint
+let patt_const_int i = newpatt_annot (Q.PatConst (nolabel, (Q.Int (Big_int.big_int_of_int i)))) tyint
let const_string s = newexpr_annot (Q.Const (nolabel, (Q.String s))) tystring
let patt_const_string s = newpatt_annot (Q.PatConst (nolabel, (Q.String s))) tystring
let expr_true () = const_int 1
let expr_false () = const_int 0
-let expr_and x y = match x, y with
- | Q.Const (_, (Q.Int i)), z
- | z, Q.Const (_, (Q.Int i)) -> if i <> 0 then z else expr_false ()
- | _ -> make_match x [patt_const_int 0, expr_false(); newpatt_annot (Q.PatAny nolabel) tybool, y]
+
let make_ifthenelse x ethen eelse = match x with
- | Q.Const (_, Q.Int i) -> if i <> 0 then ethen else eelse
+ | Q.Const (_, Q.Int i) -> if i <> Big_int.big_int_of_int 0 then ethen else eelse
| _ -> make_match x [patt_const_int 0, eelse; newpatt_annot (Q.PatAny nolabel) tybool, ethen]
let make_list l ty =
@@ -1200,9 +1200,9 @@ module CodeGenerator ( Arg : DbGenByPass.S ) = struct
H.make_match
(H.apply_lambda (Bypass.is_db_new()) (db_id @: C.Db.t ()))
[
- (H.newpatt_annot (QC.patconst (Q.Int 1)) H.tyint,
+ (H.newpatt_annot (QC.patconst (Q.Int (Big_int.big_int_of_int 1))) H.tyint,
set_init_code serial_sch tr1_id);
- (H.newpatt_annot (QC.patconst (Q.Int 0)) H.tyint,
+ (H.newpatt_annot (QC.patconst (Q.Int (Big_int.big_int_of_int 0))) H.tyint,
check_init_code db_id serial_sch tr1_id)
]
in
@@ -60,7 +60,7 @@ module ColVar = QmlTypeVars.ColVar
*)
type const_expr =
- | Int of int (** simplify the life in opa / ml code generator *)
+ | Int of Big_int.big_int
| Float of float
| String of string
@@ -86,7 +86,7 @@ struct
(** Return a human-readable version of a simple value.*)
let string_of_expr = function
- | Int i -> string_of_int i
+ | Int i -> Big_int.string_of_big_int i
| Float f -> string_of_float f
| String s -> Printf.sprintf "%S" s
@@ -201,7 +201,7 @@ struct
let fresh_internal n = ident (Ident.next n)
let const e = Q.Const (a(), e)
- let int i = const (Q.Int i)
+ let int i = const (Q.Int (Big_int.big_int_of_int i))
let float f = const (Q.Float f)
let string s = const (Q.String s)
@@ -518,7 +518,7 @@ struct
let int ?pos annotmap x =
let annotmap, label = typed_label ?pos annotmap ty_int in
- annotmap, Q.Const (label, Q.Int x)
+ annotmap, Q.Const (label, Q.Int (Big_int.big_int_of_int x))
let float ?pos annotmap x =
let annotmap, label = typed_label ?pos annotmap ty_float in
@@ -961,7 +961,7 @@ struct
let fresh_internal ?(label=Annot.next_label nopos) n = ident ~label (Ident.next n)
let const ?(label=Annot.next_label nopos) e = Q.Const (label, e)
- let int ?(label=Annot.next_label nopos) i = const ~label (Q.Int i)
+ let int ?(label=Annot.next_label nopos) i = const ~label (Q.Int (Big_int.big_int_of_int i))
let float ?(label=Annot.next_label nopos) f = const ~label (Q.Float f)
let string ?(label=Annot.next_label nopos) s = const ~label (Q.String s)
@@ -1214,17 +1214,20 @@ struct
let get_missing l =
let l = List.sort compare_const l |> List.uniq ~cmp:compare_const in
let between v v'= match v,v' with
- | Q.Int i, Q.Int i' -> if i+1=i' then [] else [Q.Int( i+1 )]
+ | Q.Int i, Q.Int i' ->
+ let s = Big_int.succ_big_int i in
+ if Big_int.eq_big_int s i' then [] else [Q.Int( s )]
| Q.Float f, Q.Float f' -> let f'' = (f+.f')/.2.0 in if f<f'' && f''< f' then [Q.Float f''] else []
| Q.String s, Q.String s' -> [Q.String (s^"_"^s')]
| Q.String _ , _ | Q.Int _ , _ | Q.Float _,_ -> assert false
in
let outside first last = match first,last with
| Q.Int i, Q.Int i' ->
- if i= min_int then
- if i'= max_int then [ Q.String "Nothing" ]
- else [Q.Int (i'+1)]
- else [Q.Int (i-1)]
+ if Big_int.eq_big_int i (QmlAstUtils.Const.min_int ()) then
+ if Big_int.eq_big_int i' (QmlAstUtils.Const.max_int ()) then
+ [ Q.String "Nothing" ]
+ else [Q.Int (Big_int.succ_big_int i')]
+ else [Q.Int (Big_int.pred_big_int i)]
| Q.Float f, Q.Float f' ->
if f = -. infinity then
if f' = infinity then [ Q.String "Nothing" ]

0 comments on commit 74bd3fd

Please sign in to comment.