[Typer] [Git][monnier/typer][tp/ift6172-2020] * src/env.ml (BI): Use `Z` rather than `Big_int`

Stefan gitlab at mg.gitlab.com
Tue Oct 13 11:24:35 EDT 2020



Stefan pushed to branch tp/ift6172-2020 at Stefan / Typer


Commits:
560dc5ba by Stefan Monnier at 2020-10-13T11:24:22-04:00
* src/env.ml (BI): Use `Z` rather than `Big_int`

* GNUmakefile (OBFLAGS): Use Zarith rather than Num

- - - - -


3 changed files:

- GNUmakefile
- src/env.ml
- src/eval.ml


Changes:

=====================================
GNUmakefile
=====================================
@@ -8,7 +8,7 @@ SRC_FILES := $(wildcard ./src/*.ml)
 CPL_FILES := $(wildcard ./$(BUILDDIR)/src/*.cmo)
 TEST_FILES := $(wildcard ./tests/*_test.ml)
 
-OBFLAGS = -tag debug -tag profile -lib str -build-dir $(BUILDDIR) -pkg num
+OBFLAGS = -tag debug -tag profile -lib str -build-dir $(BUILDDIR) -pkg zarith
 # OBFLAGS         := -I $(SRCDIR) -build-dir $(BUILDDIR) -pkg str
 # OBFLAGS_DEBUG   := -tag debug -tag profile -tag "warn(+20)"
 # OBFLAGS_RELEASE := -tag unsafe -tag inline


=====================================
src/env.ml
=====================================
@@ -3,7 +3,7 @@
  *
  * ---------------------------------------------------------------------------
  *
- *      Copyright (C) 2011-2019  Free Software Foundation, Inc.
+ *      Copyright (C) 2011-2020  Free Software Foundation, Inc.
  *
  *   Author: Pierre Delaunay <pierre.delaunay at hec.ca>
  *   Keywords: languages, lisp, dependent types.
@@ -37,7 +37,7 @@ open Sexp
 open Elexp
 module M = Myers
 module L = Lexp
-module BI = Big_int
+module BI = Z                   (* Was Big_int  *)
 module DB = Debruijn
 
 let dloc = Util.dummy_location
@@ -49,7 +49,7 @@ let str_idx idx = "[" ^ (string_of_int idx) ^ "]"
 
 type value_type =
     | Vint of int
-    | Vinteger of BI.big_int
+    | Vinteger of BI.t
     | Vstring of string
     | Vcons of symbol * value_type list
     | Vbuiltin of string
@@ -71,7 +71,7 @@ type value_type =
 let rec value_equal a b =
   match a, b with
     | Vint (i1), Vint (i2)          -> i1 = i2
-    | Vinteger (i1), Vinteger (i2)  -> BI.eq_big_int i1 i2
+    | Vinteger (i1), Vinteger (i2)  -> i1 = i2
     | Vstring (s1), Vstring (s2)    -> s1 = s2
     | Vbuiltin (s1), Vbuiltin (s2)  -> s1 = s2
     | Vfloat (f1), Vfloat (f2)      -> f1 = f2
@@ -138,7 +138,7 @@ let rec value_string v =
     | Vstring  s -> "\"" ^ s ^ "\""
     | Vbuiltin s -> s
     | Vint     i -> string_of_int i
-    | Vinteger i -> BI.string_of_big_int i
+    | Vinteger i -> BI.to_string i
     | Vfloat   f -> string_of_float f
     | Vsexp    s -> sexp_string s
     | Vtype    e -> L.lexp_string e


=====================================
src/eval.ml
=====================================
@@ -3,7 +3,7 @@
  *
  * ---------------------------------------------------------------------------
  *
- *      Copyright (C) 2011-2019  Free Software Foundation, Inc.
+ *      Copyright (C) 2011-2020  Free Software Foundation, Inc.
  *
  *   Author: Pierre Delaunay <pierre.delaunay at hec.ca>
  *   Keywords: languages, lisp, dependent types.
@@ -199,10 +199,10 @@ let add_binary_biop name f =
     | _ -> error loc ("`" ^ name ^ "` expects 2 Integer arguments") in
   add_builtin_function name f 2
 
-let _ = add_binary_biop "+"  BI.add_big_int;
-        add_binary_biop "-"  BI.sub_big_int;
-        add_binary_biop "*"  BI.mult_big_int;
-        add_binary_biop "/"  BI.div_big_int
+let _ = add_binary_biop "+"  BI.add;
+        add_binary_biop "-"  BI.sub;
+        add_binary_biop "*"  BI.mul;
+        add_binary_biop "/"  BI.div
 
 let add_binary_bool_biop name f =
   let name = "Integer." ^ name in
@@ -212,17 +212,17 @@ let add_binary_bool_biop name f =
     | _ -> error loc ("`" ^ name ^ "` expects 2 Integer arguments") in
   add_builtin_function name f 2
 
-let _ = add_binary_bool_biop "<"  BI.lt_big_int;
-        add_binary_bool_biop ">"  BI.gt_big_int;
-        add_binary_bool_biop "="  BI.eq_big_int;
-        add_binary_bool_biop ">=" BI.ge_big_int;
-        add_binary_bool_biop "<=" BI.le_big_int;
+let _ = add_binary_bool_biop "<"  BI.lt;
+        add_binary_bool_biop ">"  BI.gt;
+        add_binary_bool_biop "="  BI.equal;
+        add_binary_bool_biop ">=" BI.geq;
+        add_binary_bool_biop "<=" BI.leq;
         let name = "Int->Integer" in
         add_builtin_function
           name
           (fun loc (depth : eval_debug_info) (args_val: value_type list)
            -> match args_val with
-             | [Vint v] -> Vinteger (BI.big_int_of_int v)
+             | [Vint v] -> Vinteger (BI.of_int v)
              | _ -> error loc ("`" ^ name ^ "` expects 1 Int argument"))
           1
 
@@ -286,7 +286,7 @@ let make_string loc depth args_val  = match args_val with
   | _ -> error loc "Sexp.string expects one string as argument"
 
 let make_integer loc depth args_val = match args_val with
-  | [Vinteger n] -> Vsexp (Integer (loc, BI.int_of_big_int n))
+  | [Vinteger n] -> Vsexp (Integer (loc, BI.to_int n))
   | _ -> error loc "Sexp.integer expects one integer as argument"
 
 let make_float loc depth args_val   = match args_val with
@@ -591,7 +591,7 @@ and sexp_dispatch loc depth args =
              eval str (add_rte_variable ddummy (Vstring s) rctx)
         | Integer (_ , i)    ->
              let rctx = ctx_it in
-             eval it (add_rte_variable ddummy (Vinteger (BI.big_int_of_int i))
+             eval it (add_rte_variable ddummy (Vinteger (BI.of_int i))
                         rctx)
         | Float   (_ , f)    ->
              let rctx = ctx_flt in
@@ -673,7 +673,7 @@ let int_to_string loc depth args_val = match args_val with
   | _ -> error loc "Int->String expects one Int argument"
 
 let integer_to_string loc depth args_val = match args_val with
-  | [Vinteger x] -> Vstring (BI.string_of_big_int x)
+  | [Vinteger x] -> Vstring (BI.to_string x)
   | _ -> error loc "Integer->String expects one Integer argument"
 
 let sys_exit loc depth args_val = match args_val with



View it on GitLab: https://gitlab.com/monnier/typer/-/commit/560dc5ba95dc5cb4638e8db3563e9b6941e35c3e

-- 
View it on GitLab: https://gitlab.com/monnier/typer/-/commit/560dc5ba95dc5cb4638e8db3563e9b6941e35c3e
You're receiving this email because of your account on gitlab.com.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mailman.iro.umontreal.ca/pipermail/typer/attachments/20201013/c9f58179/attachment-0001.htm>


More information about the Typer mailing list