sailor : bring back generics support

.github/workflows/build.yml

@@ -7,41 +7,38 @@ on:
 
 jobs:
   build:
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
 
     steps:
-      - uses: kenchan0130/actions-system-info@master
+      - uses: kenchan0130/actions-system-info@v1.3.1
         id: system-info
       # Checks-out the repository
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
 
 
-      - name: setup llvm 14 repo 
+      - name: setup llvm 19 repo
         run: |
-          echo "deb http://apt.llvm.org/focal/ llvm-toolchain-focal-14 main" | sudo tee -a /etc/apt/sources.list
-          echo "deb-src http://apt.llvm.org/focal/ llvm-toolchain-focal-14 main"  | sudo tee -a /etc/apt/sources.list
+          echo "deb http://apt.llvm.org/noble/ llvm-toolchain-noble-19 main" | sudo tee -a /etc/apt/sources.list
+          echo "deb-src http://apt.llvm.org/noble/ llvm-toolchain-noble-19 main"  | sudo tee -a /etc/apt/sources.list
           wget -O - https://apt.llvm.org/llvm-snapshot.gpg.key|sudo apt-key add -
           sudo apt update
 
 
       - name: Set up OCaml
-        # You may pin to the exact commit or the version.
-        # uses: ocaml/setup-ocaml@6d924c1a7769aa5cdd74bdd901f6e24eb05024b1
-        uses: ocaml/setup-ocaml@v2
+        uses: ocaml/setup-ocaml@v3
         with:
-          ocaml-compiler: 4.14.X
+          ocaml-compiler: 5
 
 
       - run: opam install . --deps-only
 
       - run: opam exec -- dune build
 
-      - name: Archive saili and sailor
-        uses: actions/upload-artifact@v3
+      - name: Archive sailor
+        uses: actions/upload-artifact@v4
         with:
-          name: saili and sailor for ${{ steps.system-info.outputs.release }}
+          name: sailor for ${{ steps.system-info.outputs.release }}
           path: |
-            _build/install/default/bin/saili
             _build/install/default/bin/sailor
           if-no-files-found: error
 

bin/dune

@@ -8,6 +8,10 @@
     fmt
     fmt.tty
     fmt.cli
+    ctypes.foreign
     logs.cli
+    llvm.passbuilder
     )
-  (public_name sailor))
+  (public_name sailor)
+  (modes byte exe)
+)

bin/sailor.ml

@@ -1,13 +1,14 @@
 open Common
 open TypesCommon
 open SailParser
-module E = Error.Logger
+module E = Logging.Logger
 module Const  = Constants
 module C = Codegen
 
 (* llvm *)
 module L = Llvm
 module T = Llvm_target
+module P = Llvm_passbuilder
 
 
 (* passes *)
@@ -17,15 +18,25 @@ module Thir = IrThir.Thir.Pass
 module Mir = IrMir.Mir.Pass
 module MirChecks = Misc.Cfg_analysis.Pass
 module Imports = Misc.Imports.Pass
-module MCall = Misc.MethodCall.Pass
 module Mono = Mono.Monomorphization.Pass
 
 (* error handling *)
 open Monad.UseMonad(E)
 
 let apply_passes (sail_module : Hir.in_body SailModule.t) (comp_mode : Cli.comp_mode) (dump_ir : bool): Mono.out_body SailModule.t E.t =
-  let hir_debug =  fun m -> let+ m in Out_channel.with_open_text (sail_module.md.name ^ ".hir.debug") (fun f -> Format.(fprintf (formatter_of_out_channel f)) "%a" IrHir.Pp_hir.ppPrintModule m); m in
-  let mir_debug =  fun m -> let+ m in Out_channel.with_open_text (sail_module.md.name ^ ".mir.debug") (fun f -> Format.(fprintf (formatter_of_out_channel f)) "%a" IrMir.Pp_mir.ppPrintModule m); m in
+  let hir_debug =  fun m -> let+ m in Out_channel.with_open_text 
+    (sail_module.md.name ^ ".hir.debug") 
+    (fun f -> IrHir.Pp_hir.ppPrintModule (Format.formatter_of_out_channel f) m); m 
+  in
+  let mir_debug =  fun m -> let+ m in Out_channel.with_open_text 
+    (sail_module.md.name ^ ".mir.debug") 
+    (fun f -> IrMir.Pp_mir.ppPrintModule (Format.formatter_of_out_channel f) m); m 
+  in
+
+  let mir_mono_debug =  fun (m: Mono.out_body SailModule.t E.t) -> let+ m in 
+    Out_channel.with_open_text 
+    (sail_module.md.name ^ ".mir_mono.debug") 
+    Format.(fun f -> (pp_print_list IrMir.Pp_mir.ppPrintMethod) (formatter_of_out_channel f) m.body.monomorphics); m in
 
   let open Pass.Progression in 
   let active_if cond p = if cond then p else Fun.id in 
@@ -35,11 +46,11 @@ let apply_passes (sail_module : Hir.in_body SailModule.t) (comp_mode : Cli.comp_
     @> active_if dump_ir hir_debug
     @> Thir.transform 
     @> Imports.transform 
-    @> MCall.transform 
     @> Mir.transform
     @> MirChecks.transform
     @> active_if dump_ir mir_debug
     @> Mono.transform
+    @> active_if dump_ir mir_mono_debug
     @> finish 
   in run passes (return sail_module)
 
@@ -52,24 +63,6 @@ let set_target (llm : Llvm.llmodule) (triple:string) : Llvm_target.Target.t * Ll
   (target,machine)
 
 
-let add_opt_passes (pm : [`Module] Llvm.PassManager.t) : unit  = 
-  (* seems to be deprecated
-    TargetMachine.add_analysis_passes pm machine; *)
-
-  (* base needed for other passes *)
-  Llvm_scalar_opts.add_memory_to_register_promotion pm;
-  (* eleminates redundant values and loads *)
-  Llvm_scalar_opts.add_gvn pm;
-  (* reassociate binary expressions *)
-  Llvm_scalar_opts.add_reassociation pm;
-  (* dead code elimination, basic block merging and more *)
-  Llvm_scalar_opts.add_cfg_simplification pm;
-
-  Llvm_ipo.add_global_optimizer pm;
-  Llvm_ipo.add_constant_merge pm;
-  Llvm_ipo.add_function_inlining pm
-
-
 let link ?(is_lib = false) (llm:Llvm.llmodule) (module_name : string) (basepath:string) (imports: string list) (libs : string list) (target, machine) clang_args : int =
   let f = Filename.(concat basepath module_name ^ Const.object_file_ext) in
   let triple = T.TargetMachine.triple machine in
@@ -146,21 +139,23 @@ let sailor (files: string list) (intermediate:bool) (jit:bool) (noopt:bool) (dum
 
   let compile sail_module basepath (comp_mode : Cli.comp_mode) : unit E.t =
     let* m = apply_passes sail_module comp_mode dump_ir in    
-    let+ llm = C.Codegen_.moduleToIR m verify_ir in
+    let* llm = C.Codegen_.moduleToIR m verify_ir in
 
     (* only generate mir file if codegen succeeds *)
     marshal_sm Filename.(concat basepath m.md.name ^ Const.mir_file_ext) m;
 
     let tm = set_target llm target_triple in
 
-    if not noopt && comp_mode <> Library then 
-        L.PassManager.(
-          let pm = create () in add_opt_passes pm;
-          let res = run_module llm pm in
-          Logs.debug (fun m -> m "pass manager executed, module modified : %b" res);
-          dispose pm
+    let+ () = if not noopt && comp_mode <> Library then 
+        P.(
+          let options = create_passbuilder_options () in
+          Logs.debug (fun m -> m "LLVM: running passes");
+          let res = run_passes llm "default<O3>" (snd tm) options in
+          dispose_passbuilder_options options;
+          E.throw_if_result Logging.(fun m -> make_msg dummy_pos m) res
         )
-    ;
+      else E.pure ()
+    in
 
     if intermediate then L.print_module Filename.(concat basepath m.md.name ^ Const.llvm_ir_ext) llm;
 
@@ -218,27 +213,29 @@ let sailor (files: string list) (intermediate:bool) (jit:bool) (noopt:bool) (dum
                 "a module cannot import itself" 
               else 
               "dependency cycle : "  ^ (String.concat " -> " ((List.split compiling |> fst |> List.rev) @ [slmd.md.name;i.mname]))
-              in Error.make i.loc msg
+              in Logging.make_msg i.loc msg
             )  (List.mem_assoc i.mname compiling) in         
             let mir_name = i.mname ^ Const.mir_file_ext in
             let source = i.mname ^ Const.sail_file_ext in
 
             let import = fun m -> {i with dir=Filename.(dirname m ^ dir_sep); proc_order=(List.length compiling)} in 
 
             match find_file_opt source ~paths:(Filename.current_dir_name::paths),find_file_opt mir_name with
-            | Some s,Some m when let mir = unmarshal_sm m in 
+            | Some s,Some m when List.length force_comp < 2  && let mir = unmarshal_sm m in 
                                     Digest.(equal mir.md.hash @@ file s) && 
-                                    List.length force_comp < 2 && 
                                     mir.md.version = Const.sailor_version -> (* mir up-to-date with source -> use mir *)
               return (treated,import m)
             | None, Some m -> (* mir but no source -> use mir *)
+              let* () = E.throw_if Logging.(make_msg dummy_pos 
+                @@ Printf.sprintf "module '%s' has no source but forceful rebuild requested, aborting..." source) (List.length force_comp = 2) 
+              in
               let mir = unmarshal_sm m in
               E.throw_if 
-              (Error.make dummy_pos @@ Printf.sprintf "module %s was compiled with sailor %s, current is %s" mir.md.name mir.md.version Const.sailor_version)
+              Logging.(make_msg dummy_pos @@ Printf.sprintf "module '%s' was compiled with sailor %s, current is %s" mir.md.name mir.md.version Const.sailor_version)
               (mir.md.version <> Const.sailor_version) 
               >>| fun () -> treated,import m
             | None,None -> (* nothing to work with *)
-              E.throw @@ Error.make i.loc "import not found"
+              E.throw Logging.(make_msg i.loc "import not found")
             | Some s, _ -> (* source but no mir or mir not up-to-date -> compile *)
               begin
               let+ treated = process_file s treated ((slmd.md.name,i.loc)::compiling) Cli.Library
@@ -257,7 +254,7 @@ let sailor (files: string list) (intermediate:bool) (jit:bool) (noopt:bool) (dum
       (* if mir file exists, check hash, if same hash, no need to compile *)
       if Sys.file_exists mir_file && (List.length force_comp = 0) then
         let mir = unmarshal_sm mir_file in
-        let* () = E.throw_if (Error.make dummy_pos @@ Printf.sprintf "module %s was compiled with sailor %s, current is %s" mir.md.name mir.md.version Const.sailor_version)
+        let* () = E.throw_if Logging.(make_msg dummy_pos @@ Printf.sprintf "module %s was compiled with sailor %s, current is %s" mir.md.name mir.md.version Const.sailor_version)
                   (mir.md.version <> Const.sailor_version) 
         in
         if not @@ Digest.equal mir.md.hash slmd.md.hash then
@@ -272,10 +269,13 @@ let sailor (files: string list) (intermediate:bool) (jit:bool) (noopt:bool) (dum
       in 
 
   try
-    match ListM.fold_left (fun t f -> let+ t = process_file f t [] comp_mode in f::t) [] files with
-    | Ok treated,_ -> Logs.debug (fun m -> m "files processed : %s " @@ String.concat " " treated) ; `Ok ()
-    | Error e,errs -> 
-      Error.print_errors (e::errs);
+    let process_files = ListM.fold_left (fun t f -> let+ t = process_file f t [] comp_mode in f::t) [] in
+    match process_files files with
+    | Ok treated,l -> 
+      Logging.print_log l;
+      Logs.debug (fun m -> m "files processed : %s " @@ String.concat " " treated) ; `Ok ()
+    | Error e,l -> 
+      Logging.print_log {l with errors=e::l.errors};
       `Error(false, "compilation aborted") 
   with
   | e ->

dune-project

@@ -1,8 +1,9 @@
-(lang dune 3.2)
+(lang dune 3.7)
 (name "sail-pl")
 (version 0.1)
 (using menhir 2.0)
 (generate_opam_files true)
+(map_workspace_root false)
 
 (license GPL) 
 (authors "Frederic Dabrowski")
@@ -15,13 +16,13 @@
   (synopsis "SAIL: Safe Interactive Language")
   (description "SAIL means Safe Interactive Language.")
   (depends 
-    (ocaml (>= 4.13.1))
+    (ocaml (>= 5.1.0))
     (cmdliner (>= 1.1.1))
     (fmt  (>= 0.9.0))
     (menhir (>= 2.0))
     (logs (>= 0.7))
     (mtime (>= 1.3.0))
     (ctypes-foreign (>= 0.18.0))
-    (llvm (>= 13.0.0))
+    (llvm (= 19-shared))
     zarith
     ))

examples/imperative/arrays/minArray.sl

@@ -10,5 +10,5 @@ Run:
         cpt = cpt + 1
     }
     print_int (a[res]); print_newline();
-    exit(0);
+    quit();
 }

examples/imperative/arrays/sumArray.sl

@@ -14,5 +14,5 @@ Run:
     }
     print_int (res); print_newline();
     print_string("Hello\n");
-    exit(0);
+    quit();
 }

examples/imperative/complex/list.sl

@@ -49,5 +49,5 @@ Loop:
     var u : int = length(l);
     print_int(u);print_newline();
     print_int(length(l));print_newline();
-    exit(0);
+    quit();
 }

examples/imperative/complex/testLVal.sl

@@ -41,5 +41,5 @@ Loop:
     };
     var y : int = *a[0] + *a[1];
     if (y == 5) print_string ("OK\n") else print_string ("KO\n");
-    exit(0);
+    quit();
 }

examples/imperative/genericity/generics2.sl

@@ -19,5 +19,5 @@ process Main {
 
 //      printf("%b\n", b);
 //	printf("%c\n", c);
-    exit(0);
+    quit();
 }

examples/imperative/genericity/min2.sl

@@ -7,5 +7,5 @@ process Main {
         print_int(min(3,4)); 
         print_newline ();
 //      printf("%f\n", min(3.5,4.5));
-    exit(0);
+    quit();
 }

examples/imperative/genericity/minArrayGeneric.sl

@@ -27,5 +27,5 @@ Loop:
 
 	printf("%i\n", getMin(a));
 	printf("%f\n", getMin(c));
-    exit(0);
+    quit();
 }

examples/imperative/genericity/testInnerGenericity.sl

@@ -12,5 +12,5 @@ Init:
 Loop:
 
     f(1);
-    exit(0);
+    quit();
 }

examples/imperative/genericity/testInnerGenericity2.sl

@@ -12,5 +12,5 @@ Init:
 Loop:
 
     print_int(f(g(1), 2, 2.1));    ;
-    exit(0);
+    quit();
 }

examples/imperative/loops/sum.sl

@@ -14,5 +14,5 @@ process Main {
 Run:
     print_int(sumTo(10));
     print_newline();
-    exit(0);
+    quit();
 }

examples/imperative/loops/while1.sl

@@ -9,5 +9,5 @@ Run:
     }
     print_int(x);
     print_string(" Worlds\n");
-    exit(0);
+    quit();
 }

examples/imperative/pointers/bettercallsaul.sl

@@ -24,5 +24,5 @@ Loop:
     print_string(" ");
     print_int(z);
     print_newline();
-    exit(0);
+    quit();
 }

examples/imperative/pointers/drop1.sl

@@ -14,5 +14,5 @@ Loop:
      //print_int(*x); print_newline();
     // print_int(y); print_newline()
     x = box(3);
-    exit(0);
+    quit();
 }

examples/imperative/pointers/drop2.sl

@@ -11,5 +11,5 @@ Loop:
         // Ok, the content of y was tagged as moved, no free here
     }
     // OK, the pointer is freed once here;
-    exit(0);
+    quit();
 }

examples/imperative/pointers/drop3.sl

@@ -13,5 +13,5 @@ Loop:
     // Error x is not initialized as we don't enter the loop
     // print_int(*x); print_newline()
 ;
-    exit(0);
+    quit();
 }

examples/imperative/pointers/drop4.sl

@@ -15,5 +15,5 @@ Loop:
     // Error x is points to the box which has been freed
     // print_int(*x); print_newline();
     // x = box(5) // needed otherwise we will try to drop the box a second time;
-    exit(0);
+    quit();
 }

examples/imperative/pointers/dropassign1.sl

@@ -8,5 +8,5 @@ Loop:
   x = box(3);
   x = box(1);
   print_string("done\n");
-    exit(0);
+    quit();
 }