Permalink
Browse files

Removed Big_int.

Big_int is an abstract type, and it complicates things whenever we use (=),
including functions such as List.mem and Common.uniq. Since we never use big
integers, I replaced them with ordinary integers.
  • Loading branch information...
1 parent 6fa5fc9 commit b64a3ab6d2fca08b35f27e8328685d8f085d6c17 @matijapretnar committed May 16, 2012
Showing with 37 additions and 47 deletions.
  1. +1 −1 Makefile.am
  2. +1 −1 Makefile.in
  3. +3 −3 src/check.ml
  4. +1 −17 src/common.ml
  5. +3 −3 src/eval.ml
  6. +11 −11 src/external.ml
  7. +5 −5 src/lexer.mll
  8. +1 −1 src/parser.mly
  9. +1 −1 src/print.ml
  10. +2 −2 src/value.ml
  11. +1 −1 tests/lexer.eff
  12. +1 −1 tests/lexer.eff.ref
  13. +6 −0 tests/patterns.eff.ref
View
@@ -9,7 +9,7 @@ effdir=$(datarootdir)/eff
EFFTARGET=src/eff
# How to compile
-EFFOCAMLBUILD=$(OCAMLBUILD) -use-menhir -lib nums -lib unix
+EFFOCAMLBUILD=$(OCAMLBUILD) -use-menhir -lib unix
.PHONY: test test-validate test-clean \
eff.byte eff.native eff.d.byte eff.p.native
View
@@ -205,7 +205,7 @@ EXTRA_DIST = pervasives.eff tests examples src etc LICENSE.txt INSTALL.txt READM
EFFTARGET = src/eff
# How to compile
-EFFOCAMLBUILD = $(OCAMLBUILD) -use-menhir -lib nums -lib unix
+EFFOCAMLBUILD = $(OCAMLBUILD) -use-menhir -lib unix
all: all-am
.SUFFIXES:
View
@@ -59,13 +59,13 @@ let find_constructors lst tctx =
(* Try to find an unmatched value in a countable set of constants. *)
| Const c ->
let first = function
- | C.Integer _ -> C.Integer Big_int.zero_big_int
+ | C.Integer _ -> C.Integer 0
| C.String _ -> C.String ""
| C.Boolean _ -> C.Boolean false
| C.Float _ -> C.Float 0.0
in
let next = function
- | C.Integer v -> C.Integer (Big_int.succ_big_int v)
+ | C.Integer v -> C.Integer (succ v)
| C.String v -> C.String (v ^ "*")
| C.Boolean v -> C.Boolean (not v)
| C.Float v -> C.Float (v +. 1.0)
@@ -115,7 +115,7 @@ let specialize_vector tctx con = function
| Some p -> Some (p :: lst)
| None -> Some lst
end
- | Const c, P.Const c' when C.equal_const c c' -> Some lst
+ | Const c, P.Const c' when c = c' -> Some lst
| _, (P.Nonbinding | P.Var _) -> Some ((C.repeat (P.Nonbinding, C.Nowhere) (arity con)) @ lst)
| _ -> None
end
View
@@ -25,27 +25,11 @@ let join_pos (_, pos1) (_, pos2) =
(** Primitive constants *)
type const =
- | Integer of Big_int.big_int
+ | Integer of int
| String of string
| Boolean of bool
| Float of float
-let equal_const c1 c2 =
- match c1, c2 with
- | Integer k1, Integer k2 -> Big_int.eq_big_int k1 k2
- | String s1, String s2 -> s1 = s2
- | Boolean b1, Boolean b2 -> b1 = b2
- | Float f1, Float f2 -> f1 = f2
- | _, _ -> false
-
-let less_than_const c1 c2 =
- match c1, c2 with
- | Integer k1, Integer k2 -> Big_int.lt_big_int k1 k2
- | String s1, String s2 -> String.compare s1 s2 < 0
- | Boolean b1, Boolean b2 -> not b1 && b2
- | Float f1, Float f2 -> f1 < f2
- | _, _ -> false
-
(** Variants for the built-in list type *)
let cons = "$1cons"
let nil = "$0nil"
View
@@ -46,7 +46,7 @@ let rec extend_value p v env =
| Pattern.Variant (lbl, None), Value.Variant (lbl', None) when lbl = lbl' -> env
| Pattern.Variant (lbl, Some p), Value.Variant (lbl', Some v) when lbl = lbl' ->
extend_value p v env
- | Pattern.Const c, Value.Const c' when Common.equal_const c c' -> env
+ | Pattern.Const c, Value.Const c' when c = c' -> env
| _, _ -> raise (PatternMatch (snd p))
let extend p v env =
@@ -99,9 +99,9 @@ let rec ceval env (c, pos) = match c with
| V.Const (C.Integer k1) ->
begin match veval env e2 with
| V.Const (C.Integer k2) ->
- let cmp = (if up then Big_int.le_big_int else Big_int.ge_big_int) k1 k2 in
+ let cmp = (if up then (<=) else (>=)) k1 k2 in
if cmp then
- let k1' = (if up then Big_int.succ_big_int else Big_int.pred_big_int) k1 in
+ let k1' = (if up then succ else pred) k1 in
let r = ceval (update i (V.Const (C.Integer k1)) env) c in
sequence
(fun _ -> ceval env (I.For (i,
View
@@ -27,24 +27,24 @@ let coop f v s =
let (v, s) = f v s in V.Value (V.Tuple [v; s])
let symbols = [
- ("~-", V.from_fun (fun v -> V.value_int (Big_int.minus_big_int (V.to_int v))));
- ("~-.", V.from_fun (fun v -> V.value_float (-.(V.to_float v))));
- ("-", int_int_to_int Big_int.sub_big_int);
- ("+", int_int_to_int Big_int.add_big_int);
- ("*", int_int_to_int Big_int.mult_big_int);
- ("/", int_int_to_int Big_int.div_big_int);
- ("**", int_int_to_int Big_int.power_big_int_positive_big_int);
+ ("~-", V.from_fun (fun v -> V.value_int (~- (V.to_int v))));
+ ("~-.", V.from_fun (fun v -> V.value_float (~-. (V.to_float v))));
+ ("-", int_int_to_int (-));
+ ("+", int_int_to_int (+));
+ ("*", int_int_to_int ( * ));
+ ("/", int_int_to_int (/));
+ ("**", int_int_to_int (fun k1 k2 -> int_of_float (float_of_int k1 ** float_of_int k2)));
("-.", float_float_to_float (-.));
("+.", float_float_to_float (+.));
("*.", float_float_to_float ( *. ));
("/.", float_float_to_float (/.));
- ("%", int_int_to_int Big_int.mod_big_int);
+ ("%", int_int_to_int (mod));
("=", val_val_to (fun v1 v2 -> V.value_bool (V.equal v1 v2)));
("<", val_val_to (fun v1 v2 -> V.value_bool (V.less_than v1 v2)));
("^", val_val_to (fun v1 v2 -> V.value_str (V.to_str v1 ^ V.to_str v2)));
- ("string_length", V.from_fun (fun v -> V.value_int (Big_int.big_int_of_int (String.length (V.to_str v)))));
+ ("string_length", V.from_fun (fun v -> V.value_int (String.length (V.to_str v))));
("to_string", V.from_fun (fun v -> let s = Print.to_string "%t" (Print.value v) in V.value_str s));
- ("float", V.from_fun (fun v -> V.value_float (Big_int.float_of_big_int (V.to_int v))));
+ ("float", V.from_fun (fun v -> V.value_float (float_of_int (V.to_int v))));
("std", V.fresh_instance (Some "standard I/O") (Some (ref V.from_unit, [
("write", coop (fun v s ->
let str = V.to_str v in
@@ -63,7 +63,7 @@ let symbols = [
("rnd", (Random.self_init () ;
V.fresh_instance (Some "random number generator") (Some (ref V.from_unit, [
- ("int", coop (fun k s -> (V.from_int (Big_int.big_int_of_int (Random.int (Big_int.int_of_big_int (V.to_int k))))), s));
+ ("int", coop (fun k s -> (V.from_int (Random.int (V.to_int k))), s));
("float", coop (fun x s -> (V.from_float (Random.float (V.to_float x))), s));
]))
));
View
@@ -66,13 +66,13 @@
let position_of_lex lex =
Common.Position (Lexing.lexeme_start_p lex, Lexing.lexeme_end_p lex)
-let bigint_of_string s =
+let int_of_string s =
(* get rid of _ *)
let j = ref 0 in
for i = 0 to String.length s - 1 do
if s.[i] <> '_' then (s.[!j] <- s.[i] ; incr j)
done ;
- Big_int.big_int_of_string (String.sub s 0 !j)
+ int_of_string (String.sub s 0 !j)
}
@@ -83,7 +83,7 @@ let uname = ['A'-'Z'] ['_' 'a'-'z' 'A'-'Z' '0'-'9' '\'']*
let hexdig = ['0'-'9' 'a'-'f' 'A'-'F']
-let bigint = ['0'-'9'] ['0'-'9' '_']*
+let int = ['0'-'9'] ['0'-'9' '_']*
let xxxint =
( ("0x" | "0X") hexdig (hexdig | '_')*
@@ -108,9 +108,9 @@ rule token = parse
| '\n' { Lexing.new_line lexbuf; token lexbuf }
| [' ' '\r' '\t'] { token lexbuf }
| "(*" { comment 0 lexbuf }
- | bigint { INT (bigint_of_string (Lexing.lexeme lexbuf)) }
+ | int { INT (int_of_string (Lexing.lexeme lexbuf)) }
| xxxint { try
- INT (Big_int.big_int_of_int (int_of_string (Lexing.lexeme lexbuf)))
+ INT (int_of_string (Lexing.lexeme lexbuf))
with Failure _ -> Error.syntax ~pos:(position_of_lex lexbuf) "Invalid integer constant"
}
| float { FLOAT (float_of_string(Lexing.lexeme lexbuf)) }
View
@@ -36,7 +36,7 @@
%token BEGIN END
%token <Common.variable> LNAME
%token UNDERSCORE AS
-%token <Big_int.big_int> INT
+%token <int> INT
%token <string> STRING
%token <bool> BOOL
%token <float> FLOAT
View
@@ -36,7 +36,7 @@ and field pp (f, v) ppf = fprintf ppf "%s = %t" f (pp v)
let const c ppf =
match c with
- | Common.Integer k -> fprintf ppf "%s" (Big_int.string_of_big_int k)
+ | Common.Integer k -> fprintf ppf "%d" k
| Common.String s -> fprintf ppf "%S" s
| Common.Boolean b -> fprintf ppf "%B" b
| Common.Float f -> fprintf ppf "%F" f
View
@@ -58,7 +58,7 @@ let value_float f = Value (from_float f)
let rec equal v1 v2 =
match v1, v2 with
- | Const c1, Const c2 -> Common.equal_const c1 c2
+ | Const c1, Const c2 -> c1 = c2
| Tuple vs1, Tuple vs2 -> equal_list vs1 vs2
| Record r1, Record r2 -> equal_record r1 r2 && equal_record r2 r1
| Variant (lbl1, None), Variant (lbl2, None) ->
@@ -85,7 +85,7 @@ and equal_operations op1 op2 =
let rec less_than v1 v2 =
match v1, v2 with
- | Const c1, Const c2 -> Common.less_than_const c1 c2
+ | Const c1, Const c2 -> c1 < c2
| Tuple vs1, Tuple vs2 -> less_than_list vs1 vs2
| Record r1, Record r2 -> less_than_record r1 r2
| Variant (lbl1, _), Variant (lbl2, _) when lbl1 < lbl2 -> true
View
@@ -5,7 +5,7 @@ let a' = 20 in a' ;;
let a'b' = 30 in a'b' ;;
let a''' = 40 in a''' ;;
-1_000_000_000_000_000_000_000_000_000_000_000_000_000_000_000 ;;
+1_000_000_000_000_000 ;;
42 ;;
(-0b101010) ;;
0b101010 ;;
View
@@ -2,7 +2,7 @@
- : int = 20
- : int = 30
- : int = 40
-- : int = 1000000000000000000000000000000000000000000000
+- : int = 1000000000000000
- : int = 42
- : int = -42
- : int = 42
View
@@ -1,6 +1,12 @@
- : int = 5
- : int * int = (1, 2)
+Warning (file "./patterns.eff", line 3, char 5): This pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+[]
- : int * int list = (1, [2; 3; 4])
+Warning (file "./patterns.eff", line 4, char 5): This pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+[]
- : int list = [2; 3; 4]
- : int = 10
- : int * int cow = (10, Moo 10)

0 comments on commit b64a3ab

Please sign in to comment.