dune

.gitignore

@@ -10,3 +10,4 @@ test.out
 a.out
 *.log
 *.tar.gz
+src/.merlin

Makefile

@@ -1,30 +1,9 @@
-
-MODE=debug
-# debug or release
-
 VERSION := $(strip $(shell scripts/getcfgvar.sh version))
 
-DEBUG_LIBS=nums.cmxa
-RELEASE_LIBS=nums.cmxa
-
-DEBUG_FLAGS=-inline 0 -g
-RELEASE_FLAGS=-inline 40 -noassert -unsafe -nodynlink -ccopt -O9
-
-SPACE :=
-SPACE +=
-COMMA = ,
-DIRS=$(shell scripts/lsdirs.sh src)
-IDIRS=$(subst $(SPACE),$(COMMA),$(DIRS))
-
-all: $(MODE)
-
-debug:
-	ocamlbuild -pp 'm4 -P' -ocamlopt "ocamlopt.opt -pp 'm4 -P' -S $(DEBUG_FLAGS) $(DEBUG_LIBS)" -Is $(IDIRS) hcpl.native
-	cp hcpl.native hcpl
-
-release:
-	ocamlbuild -pp 'm4 -P' -ocamlopt "ocamlopt.opt -pp 'm4 -P' -S $(RELEASE_FLAGS) $(RELEASE_LIBS)" -Is $(IDIRS) hcpl.native
-	cp hcpl.native hcpl
+all:
+	dune build
+	cp _build/default/src/hcpl.exe hcpl
+	chmod u+w hcpl
 
 package: clean
 	-scripts/rmbackups.sh
@@ -67,7 +46,7 @@ benchmark: release
 	scripts/run-benchmarks.sh
 
 clean:
-	ocamlbuild -clean
+	dune clean
 	-rm hcpl
 	-rm *.out
 	-rm *.log

README

@@ -1,4 +1,3 @@
-
 What do you need to compile and use HCPL?
 
 * OCaml 3.12.
@@ -19,7 +18,7 @@ To run tests type:
 To install HCPL type:
    * make configure
    * make
-   * sudo make install
+   * make install
 
 During installation you will be asked for the data directory. In this
 directory the examples, the standard library and other data files of

dune-project

@@ -0,0 +1,2 @@
+(lang dune 2.5)
+(name hcpl)

scripts/install.sh

@@ -9,7 +9,7 @@ cp -r examples/ $data_dir/examples
 cp -r tests/ $data_dir/tests
 cp README $data_dir/README
 mkdir -p $data_dir/bin
-cp hcpl $data_dir/bin/ipl
+cp hcpl $data_dir/bin/hcpl
 cp uninstall.sh $data_dir/bin/uninstall.sh
 
 ln -s $data_dir/bin/hcpl $bin_dir/hcpl

src/builtins/core_builtins.ml

@@ -4,7 +4,6 @@
 *)
 
 open Node
-open Big_int
 
 let is_number lst =
   match lst with
@@ -46,10 +45,10 @@ let module_hash = Symbol.Hash.create 16
 
 let load_module lst =
   match lst with
-  | x :: init_node :: y :: env ->
+  | x :: init_node :: y :: _ ->
       begin
         match x, y with
-        | bfrm, Sym(sym) ->
+        | _, Sym(sym) ->
             begin
               try
                 Symbol.Hash.find module_hash sym

src/builtins/list_builtins.ml

@@ -233,7 +233,7 @@ let rec do_rev_split_n f n lst acc acc2 =
 
 let do_split_n f n lst =
   match lst with
-  | Cons(h, t) -> do_rev2 (do_rev_split_n f n lst Nil Nil) Nil
+  | Cons(_, _) -> do_rev2 (do_rev_split_n f n lst Nil Nil) Nil
   | _ -> Cons(Nil, Nil)
 
 (* quoted variants *)

src/core/config.ml

@@ -7,7 +7,9 @@ let version = "git-master"
 
 let data_dir = "."
 
+[@@@warning "-32"]
 let bin_dir = "."
+[@@@warning "+32"]
 
 let dir_sep () = "/"
 

src/core/error.ml

@@ -8,7 +8,7 @@ open Lexing
 exception RuntimeError of Node.t
 
 (* 'rec' to prevent inlining *)
-let rec runtime_error msg = raise (RuntimeError(Node.String(msg)))
+let [@warning "-39"]rec runtime_error msg = raise (RuntimeError(Node.String(msg)))
 
 let err_count = Array.make 4 0
 

src/core/node.ml

@@ -280,13 +280,13 @@ let get_name node = Attrs.get_name (get_attrs node)
 
 let get_pos node = Attrs.get_pos (get_attrs node)
 
-let get_attr node name = Attrs.get_attr (get_attrs node)
+let get_attr node _ = Attrs.get_attr (get_attrs node)
 
 let is_special node = Attrs.is_special (get_attrs node)
 
 let rec is_module_closed node =
   match node with
-  | Appl(Appl(f, x, _), y, _) when f == progn -> is_module_closed y
+  | Appl(Appl(f, _, _), y, _) when f == progn -> is_module_closed y
   | Appl(f, x, _) ->
       if f == id then
         is_module_closed x
@@ -401,7 +401,7 @@ let to_string node =
         in
         let rec is_list node =
           match node with
-          | Cons(x, y) -> is_list y
+          | Cons(_, y) -> is_list y
           | Nil -> true
           | _ -> false
         in

src/dune

@@ -0,0 +1,8 @@
+(executable
+  (name hcpl)
+  (libraries num)
+  (modes native)
+  (ocamlopt_flags -inline 40 -noassert -unsafe -nodynlink -ccopt -O9)
+  (preprocess (action (run m4 -P %{input-file}))))
+
+(include_subdirs unqualified)

src/eval/bignum.ml

@@ -57,7 +57,7 @@ let mul_fits x y =
   msb x + msb y <= smallint_bits
 
 (* "rec" to prevent inlining *)
-let rec do_gt x y =
+let [@warning "-39"]rec do_gt x y =
   if is_smallint x then
     begin
       assert (not (is_smallint y));
@@ -88,7 +88,7 @@ let gt x y =
   else
     do_gt x y
 
-let rec do_ge x y =
+let [@warning "-39"]rec do_ge x y =
   if is_smallint x then
     begin
       assert (not (is_smallint y));
@@ -119,7 +119,7 @@ let ge x y =
   else
     do_ge x y
 
-let rec do_add x y =
+let [@warning "-39"]rec do_add x y =
   if is_smallint x then
     begin
       assert (not (is_smallint y));
@@ -146,7 +146,7 @@ let add x y =
   else
     do_add x y
 
-let rec do_sub x y =
+let [@warning "-39"]rec do_sub x y =
   if is_smallint x then
     begin
       assert (not (is_smallint y));
@@ -173,7 +173,7 @@ let sub x y =
   else
     do_sub x y
 
-let rec do_mul x y =
+let [@warning "-39"]rec do_mul x y =
   if is_smallint x then
     begin
       assert (not (is_smallint y));
@@ -208,7 +208,7 @@ let mul x y =
   else
     do_mul x y
 
-let rec do_idiv x y =
+let [@warning "-39"]rec do_idiv x y =
   if is_smallint x then
     begin
       assert (not (is_smallint y));
@@ -235,7 +235,7 @@ let idiv x y =
   else
     do_idiv x y
 
-let rec do_modulo x y =
+let [@warning "-39"]rec do_modulo x y =
   if is_smallint x then
     begin
       assert (not (is_smallint y));

src/eval/env.ml

@@ -43,7 +43,7 @@ let rec pop_n env n =
     begin
       assert (env != []);
       match env with
-      | h :: t -> pop_n t (n - 1)
+      | _ :: t -> pop_n t (n - 1)
       | [] -> assert (env <> []); []
     end
   else

src/eval/eval.ml

@@ -81,13 +81,6 @@ m4_define(`ACCESS_VAR', `
     in
     do_eval x $1 $2
     (* keep in mind that the values in environments are closed *)
-  (*  match x with
-    | Closure(a, env2, env2_len) ->
-        do_eval a env2 env2_len
-    | Delayed(r) ->
-        do_eval_delayed r
-    | _ -> (*assert (is_immed x || (match x with Lambda(_, 0, _, _, _) -> true | _ -> false));*) x *)
-           (* TODO: this need not be true, e.g.: let x = hd 3; This should be fixed!!! *)
   end
 ')
 
@@ -133,9 +126,7 @@ let check_limit times_entered =
   else
     true
 
-let rec do_eval_delayed r =
-  EVAL_DELAYED(r)
-and do_eval node env env_len =
+let rec do_eval node env env_len =
   (* Debug.print ("do_eval " ^ Utils.list_to_string Node.to_string env ^ ": " ^ Node.to_string node); *)
   match node with
   | Appl(x, y, attrs) ->

src/eval/match.ml

@@ -10,9 +10,9 @@ exception Unknown
 
 type match_quoted_mode_t = ModeMatch | ModeEq | ModeQuotedEq
 
-let rec check_tokens_eq lst1 lst2 =
+let [@warning "-39"]rec check_tokens_eq lst1 lst2 =
   match lst1, lst2 with
-  | ((tok1, _) :: t1), ((tok2, _) :: t2) when Token.eq tok1 tok2 -> true
+  | ((tok1, _) :: _), ((tok2, _) :: _) when Token.eq tok1 tok2 -> true
   | _ -> false
 
 let rec do_match_quoted node pat penv penv_len nenv nenv_len acc (mode : match_quoted_mode_t) =
@@ -131,10 +131,10 @@ let rec do_match_quoted node pat penv penv_len nenv nenv_len acc (mode : match_q
                   | _ ->
                       raise Exit
                 end
-            | Lambda(body, frame, _, _, attrs1) ->
+            | Lambda(body, frame, _, _, _) ->
                 begin
                   match node with
-                  | Lambda(body2, frame2, _, _, attrs2) ->
+                  | Lambda(body2, frame2, _, _, _) ->
                       if frame > penv_len || frame2 > nenv_len then
                         begin
                           raise Exit

src/eval/quote.ml

@@ -263,7 +263,7 @@ let subst node node1 node2 =
     Error.runtime_error "arguments of subst should be quoted"
 
 let do_lift node f =
-  let rec aux node =
+  let [@warning "-39"]rec aux node =
     Traversal.transform
       (fun x _ _ frames_num ->
         if f x then

src/eval/traversal.ml

@@ -238,7 +238,7 @@ let traverse f node acc =
               end
             else
               f node acc
-        | Lambda(body, frame, call_type, times_entered, attrs) ->
+        | Lambda(body, frame, _, _, _) ->
             begin
               assert (frame <= env_len);
               let env2 = Env.pop_n env (env_len - frame)
@@ -268,7 +268,7 @@ let traverse f node acc =
             end
         | Closure(x, env, env_len) ->
             Skip(aux x env env_len acc)
-        | LambdaClosure(body, env, env_len, call_type, times_entered, attrs) ->
+        | LambdaClosure(body, env, env_len, _, _, _) ->
             Skip(aux body (Dummy :: env) (env_len + 1) acc)
         | _ ->
             f node acc)

src/parsing/dune

@@ -0,0 +1 @@
+(ocamllex scanner)

src/parsing/loader.ml

@@ -7,14 +7,14 @@ type identtab_t = Node.t Symbol.Map.t
 
 let load_module name parse =
     assert (name <> "");
-    let name2 = String.copy name
+    let name2 = Bytes.of_string name
     in
-    name2.[0] <- Char.lowercase (name2.[0]);
+    Bytes.set name2 0 (Char.lowercase_ascii (Bytes.get name2 0));
     let rec loop lst =
       match lst with
       | h :: t ->
           begin
-            let path = h ^ Config.dir_sep () ^ name2 ^ ".hcpl"
+            let path = h ^ Config.dir_sep () ^ (Bytes.to_string name2) ^ ".hcpl"
             in
             try
               let lexbuf = Lexing.from_channel (open_in path)