feat!: Implement pre-compilation of exercises and graders

to cmi, cma and js.

Includes changes to the toploop to handle the dynamic loading.

Author: AltGr

README.md

@@ -53,7 +53,7 @@ The Inconsolata font is released under the Open Font License.
 See [http://www.levien.com/type/myfonts/inconsolata.html](http://www.levien.com/type/myfonts/inconsolata.html).
 
 The Biolinum font is licensed under the GNU General Public License with
-a the 'Font-Exception'.
+a 'Font-Exception'.
 See [http://www.linuxlibertine.org](http://www.linuxlibertine.org).
 
 The public instance of Learn OCaml uses the Fontin font instead of
@@ -78,9 +78,9 @@ It was written by OCamlPro from 2015 to 2018.
 
 The current main contributors are Érik Martin-Dorel, Yann Régis-Gianas, and Louis Gesbert.
 
-The initial authors were Benjamin Canou, Çağdaş Bozman, and Grégoire Henry.
+The initial authors were Benjamin Canou, Çağdaş Bozman, Grégoire Henry, and Louis Gesbert.
 
-It builds on the previous experience of Try OCaml, by Çağdaş Bozman, and Fabrice Le Fessant.
+It builds on the previous experience of Try OCaml, by Çağdaş Bozman and Fabrice Le Fessant.
 
 We heavily use js_of_ocaml, so thanks to the Ocsigen team.
 

dune

@@ -7,7 +7,7 @@
 )
 
 (env
-  (release (flags -safe-string -w +a-4-42-44-45-48-3-58)
+  (release (flags -safe-string -w +a-4-42-44-45-48-3-58-32-33)
            (ocamlc_flags)
            (ocamlopt_flags))
 )

dune-project

@@ -1,4 +1,4 @@
-(lang dune 2.3)
+(lang dune 2.4)
 (name learn-ocaml)
 (version 0.16.0)
 (allow_approximate_merlin)

src/app/learnocaml_description_main.ml

@@ -71,7 +71,7 @@ let () =
          init_tabs ();
          exercise_fetch >>= fun (ex_meta, exo, _deadline) ->
          (* display exercise questions and prelude *)
-         setup_tab_text_prelude_pane Learnocaml_exercise.(decipher File.prelude exo);
+         setup_tab_text_prelude_pane Learnocaml_exercise.(decipher File.prelude_ml exo);
          let text_iframe = Dom_html.createIframe Dom_html.document in
          Manip.replaceChildren title_container
            Tyxml_js.Html5.[ h1 [ txt ex_meta.title] ];

src/app/learnocaml_exercise_main.ml

@@ -123,16 +123,21 @@ let () =
   in
   let after_init top =
     exercise_fetch >>= fun (_meta, exo, _deadline) ->
-    begin match Learnocaml_exercise.(decipher File.prelude exo) with
-      | "" -> Lwt.return true
-      | prelude ->
-          Learnocaml_toplevel.load ~print_outcome:true top
-            ~message: [%i"loading the prelude..."]
-            prelude
-    end >>= fun r1 ->
-    Learnocaml_toplevel.load ~print_outcome:false top
-      (Learnocaml_exercise.(decipher File.prepare exo)) >>= fun r2 ->
-    if not r1 || not r2 then failwith [%i"error in prelude"] ;
+    let exercise_js = Learnocaml_exercise.(decipher File.exercise_js exo) in
+    Learnocaml_toplevel.load_cmi_from_string top
+      Learnocaml_exercise.(decipher File.prelude_cmi exo) >>= fun _ ->
+    Learnocaml_toplevel.load_cmi_from_string top
+      Learnocaml_exercise.(decipher File.prepare_cmi exo) >>= fun _ ->
+    Learnocaml_toplevel.load_js ~print_outcome:false top
+      ~message: [%i"loading the prelude..."]
+      exercise_js
+    >>= fun r ->
+    if not r then Lwt.fail_with  [%i"error in prelude"] else
+    Learnocaml_toplevel.load top "open! Prelude ;;" >>= fun r ->
+    if not r then Lwt.fail_with [%i"error in prelude"] else
+    Learnocaml_toplevel.load top "open! Prepare ;;" >>= fun r ->
+    if not r then Lwt.fail_with [%i"error in prelude"] else
+    (* TODO: maybe remove Prelude, Prepare modules from the env ? *)
     Learnocaml_toplevel.set_checking_environment top >>= fun () ->
     Lwt.return () in
   let toplevel_launch =
@@ -189,7 +194,7 @@ let () =
   EB.eval top select_tab;
   let typecheck = typecheck top ace editor in
 (*------------- prelude -----------------*)
-  setup_prelude_pane ace Learnocaml_exercise.(decipher File.prelude exo);
+  setup_prelude_pane ace Learnocaml_exercise.(decipher File.prelude_ml exo);
   Js.Opt.case
     (text_iframe##.contentDocument)
     (fun () -> failwith "cannot edit iframe document")

src/grader/dune

@@ -13,8 +13,41 @@
  (action (run odoc compile --package learn-ocaml %{deps} -o %{targets}))
 )
 
+;; needs to be a separate lib because the module is shared between evaluator
+;; parts (Grading) and dynamic parts (Test_lib)
 (library
- (name testing)
+ (name introspection_intf)
+ (wrapped false)
+ (modules introspection_intf)
+ (modules_without_implementation introspection_intf)
+ (libraries learnocaml_report ty))
+
+;; dynamic part, on which Prelude/Prepare/Test_lib etc. depend
+(library
+ (name learnocaml_callback)
+ (wrapped false)
+ (modules learnocaml_callback)
+ (modules_without_implementation learnocaml_callback)
+ ;; hack: learnocaml_callback actually does have an implementation, but it is inserted
+ ;; into the toplevel later on, through registered callbacks. Defining this lib
+ ;; ensures the compilation of `learnocaml_callback.cmi`
+ (libraries compiler-libs learnocaml_report introspection_intf))
+
+;; dynamic part, on which Test_lib depends
+(library
+ (name pre_test)
+ (wrapped false)
+ (modules pre_test)
+ (modules_without_implementation pre_test)
+ ;; hack: pre_test actually does have an implementation, but it is dynamically
+ ;; generated and injected in the environment during grading. We are interested
+ ;; in pre_test.cmi to compile test_lib.cmo, then test_lib.cmo should only be
+ ;; loaded in the specific grading toplevel env.
+ (libraries compiler-libs learnocaml_report introspection_intf))
+
+;; dynamic (but pre-compiled) part
+(library
+ (name testing_dyn)
  (wrapped false)
  (modes byte)
  (library_flags :standard -linkall)
@@ -24,18 +57,23 @@
             learnocaml_ppx_metaquot_lib
             ocplib-json-typed
             learnocaml_report
-            learnocaml_repository)
- (modules Introspection_intf
-          Introspection
-          Test_lib
-          Mutation_test)
- (modules_without_implementation Introspection_intf)
+            learnocaml_repository
+            introspection_intf
+            ;; dynamic dependencies
+            learnocaml_callback
+            pre_test
+            )
+ (modules Test_lib)
  (preprocess (pps learnocaml_ppx_metaquot))
 )
+(rule
+ (target testing_dyn.js)
+ (deps testing_dyn.cma)
+ (action (run js_of_ocaml %{deps} --wrap-with dynload --pretty)))
 
 (rule
  (targets test_lib.odoc)
- (deps .testing.objs/byte/test_lib.cmti)
+ (deps .testing_dyn.objs/byte/test_lib.cmti)
  (action (run odoc compile --package learn-ocaml %{deps} -o %{targets}))
 )
 
@@ -138,39 +176,47 @@
 )
 
 (rule
- (targets embedded_grading_cmis.ml)
- (deps (:compiler-cmis
-        %{ocaml-config:standard_library}/compiler-libs/longident.cmi
-        %{ocaml-config:standard_library}/compiler-libs/asttypes.cmi
-        %{ocaml-config:standard_library}/compiler-libs/ast_helper.cmi
-        %{ocaml-config:standard_library}/compiler-libs/ast_mapper.cmi
-        %{ocaml-config:standard_library}/compiler-libs/parsetree.cmi
-        %{ocaml-config:standard_library}/compiler-libs/location.cmi
-        %{ocaml-config:standard_library}/compiler-libs/parse.cmi
-        %{ocaml-config:standard_library}/compiler-libs/pprintast.cmi)
-       (:generated-cmis
-        ../ppx-metaquot/.ty.objs/byte/ty.cmi
-        ../ppx-metaquot/.fun_ty.objs/byte/fun_ty.cmi
-        .testing.objs/byte/introspection_intf.cmi
-        .learnocaml_report.objs/byte/learnocaml_report.cmi
-        .testing.objs/byte/test_lib.cmi
-        .testing.objs/byte/mutation_test.cmi))
+ (targets embedded_grading_lib.ml)
+ (deps
+  .learnocaml_callback.objs/byte/learnocaml_callback.cmi
+  ;; .pre_test.objs/byte/pre_test.cmi -- only test_lib should be needed
+  .testing_dyn.objs/byte/test_lib.cmi
+  testing_dyn.cma
+  testing_dyn.js)
  (action (with-stdout-to %{targets}
-           (run ocp-ocamlres -format ocamlres %{compiler-cmis} %{generated-cmis})))
+           (run ocp-ocamlres -format ocamlres %{deps})))
+)
+
+;; cmis that are needed to precompile the graders for exercises
+(install
+ (section share)
+ (package learn-ocaml)
+ (files
+  (../ppx-metaquot/.ty.objs/byte/ty.cmi as grading_cmis/ty.cmi)
+  (../ppx-metaquot/.fun_ty.objs/byte/fun_ty.cmi as grading_cmis/fun_ty.cmi)
+  (.introspection_intf.objs/byte/introspection_intf.cmi as grading_cmis/introspection_intf.cmi)
+  (.pre_test.objs/byte/pre_test.cmi as grading_cmis/pre_test.cmi)
+  (.learnocaml_report.objs/byte/learnocaml_report.cmi as grading_cmis/learnocaml_report.cmi)
+  (.learnocaml_callback.objs/byte/learnocaml_callback.cmi as grading_cmis/learnocaml_callback.cmi)
+  (.testing_dyn.objs/byte/test_lib.cmi as grading_cmis/test_lib.cmi))
 )
 
+
 (library
  (name grading)
  (wrapped false)
  (modes byte)
  (library_flags :standard -linkall)
- (libraries testing
-            learnocaml_ppx_metaquot
+ (libraries learnocaml_ppx_metaquot
             ocplib-ocamlres.runtime
+            toploop
+            introspection_intf
             embedded_cmis
             ocplib_i18n
-            learnocaml_report)
- (modules Embedded_grading_cmis
+            learnocaml_report
+            learnocaml_repository)
+ (modules Introspection
+          Embedded_grading_lib
           Grading)
  (preprocess (per_module ((pps ppx_ocplib_i18n learnocaml_ppx_metaquot) Grading)))
 )

src/grader/grader_cli.ml

@@ -7,9 +7,6 @@
  * included LICENSE file for details. *)
 
 let display_std_outputs = ref false
-let dump_outputs = ref None
-let dump_reports = ref None
-let display_callback = ref false
 let display_outcomes = ref false
 let grade_student = ref None
 let individual_timeout = ref None
@@ -47,29 +44,25 @@ let read_student_file exercise_dir path =
   else
     Lwt_io.with_file ~mode:Lwt_io.Input fn Lwt_io.read
 
-let grade ?(print_result=false) ?dirname meta exercise output_json =
+let grade ?(print_result=false) ?dirname
+    ~dump_outputs ~dump_reports ~display_callback
+    meta exercise output_json =
   Lwt.catch
     (fun () ->
        let code_to_grade = match !grade_student with
          | Some path -> read_student_file (Sys.getcwd ()) path
-         | None ->
-             Lwt.return (Learnocaml_exercise.(decipher File.solution exercise)) in
+         | None -> Lwt.return (Learnocaml_exercise.(decipher File.solution exercise)) in
        let callback =
-         if !display_callback then Some (Printf.eprintf "[ %s ]%!\r\027[K") else None in
+         if display_callback then Some (Printf.eprintf "[ %s ]%!\r\027[K") else None in
        let timeout = !individual_timeout in
        code_to_grade >>= fun code ->
        Grading_cli.get_grade ?callback ?timeout ?dirname exercise code
        >>= fun (result, stdout_contents, stderr_contents, outcomes) ->
        flush stderr;
        match result with
-       | Error exn ->
+       | Error err ->
            let dump_error ppf =
-             begin match Grading.string_of_exn exn with
-               | Some msg ->
-                   Format.fprintf ppf "%s@." msg
-               | None ->
-                   Format.fprintf ppf "%a@." Location.report_exception exn
-             end;
+             Format.fprintf ppf "%s@." (Grading.string_of_err err);
              if stdout_contents <> "" then begin
                Format.fprintf ppf "grader stdout:@.%s@." stdout_contents
              end ;
@@ -79,7 +72,7 @@ let grade ?(print_result=false) ?dirname meta exercise output_json =
              if outcomes <> "" then begin
                Format.fprintf ppf "grader outcomes:@.%s@." outcomes
              end in
-           begin match !dump_outputs with
+           begin match dump_outputs with
              | None -> ()
              | Some prefix ->
                  let oc = open_out (prefix ^ ".error") in
@@ -92,7 +85,7 @@ let grade ?(print_result=false) ?dirname meta exercise output_json =
            let (max, failure) = Learnocaml_report.result report in
            if !display_reports then
              Learnocaml_report.print (Format.formatter_of_out_channel stderr) report;
-           begin match !dump_reports with
+           begin match dump_reports with
              | None -> ()
              | Some prefix ->
                  let oc = open_out (prefix ^ ".report.txt") in
@@ -103,7 +96,7 @@ let grade ?(print_result=false) ?dirname meta exercise output_json =
                  close_out oc
            end ;
            if stderr_contents <> "" then begin
-             begin match !dump_outputs with
+             begin match dump_outputs with
                | None -> ()
                | Some prefix ->
                    let oc = open_out (prefix ^ ".stderr") in
@@ -114,7 +107,7 @@ let grade ?(print_result=false) ?dirname meta exercise output_json =
                Format.eprintf "%s" stderr_contents
            end ;
            if stdout_contents <> "" then begin
-             begin match !dump_outputs with
+             begin match dump_outputs with
                | None -> ()
                | Some prefix ->
                    let oc = open_out (prefix ^ ".stdout") in
@@ -125,7 +118,7 @@ let grade ?(print_result=false) ?dirname meta exercise output_json =
                Format.printf "%s" stdout_contents
            end ;
            if outcomes <> "" then begin
-             begin match !dump_outputs with
+             begin match dump_outputs with
                | None -> ()
                | Some prefix ->
                    let oc = open_out (prefix ^ ".outcomes") in
@@ -163,7 +156,8 @@ let grade ?(print_result=false) ?dirname meta exercise output_json =
                  Lwt.return (Ok ())
            end)
     (fun exn ->
-       begin match !dump_outputs with
+       Lwt.wrap @@ fun () ->
+       begin match dump_outputs with
          | None -> ()
          | Some prefix ->
              let oc = open_out (prefix ^ ".error") in
@@ -172,15 +166,20 @@ let grade ?(print_result=false) ?dirname meta exercise output_json =
                "%a@!" Location.report_exception exn ;
              close_out oc
        end ;
-       Format.eprintf "%a" Location.report_exception exn ;
-       Lwt.return (Error (-1)))
+       Format.eprintf "%a" Location.report_exception exn;
+       Error (-1))
 
-let grade_from_dir ?(print_result=false) exercise_dir output_json =
+let grade_from_dir
+    ?(print_result=false)
+    ~dump_outputs ~dump_reports ~display_callback
+    exercise_dir output_json =
   let exercise_dir = remove_trailing_slash exercise_dir in
   read_exercise exercise_dir >>= fun exo ->
   Lwt_io.(with_file ~mode:Input (String.concat Filename.dir_sep [exercise_dir; "meta.json"]) read) >>= fun content ->
   let meta = (match content with
               | "" -> `O []
               | s -> Ezjsonm.from_string s)
              |> Json_encoding.destruct Learnocaml_data.Exercise.Meta.enc in
-  grade ~print_result ~dirname:exercise_dir meta exo output_json
+  grade
+    ~dump_outputs ~dump_reports ~display_callback
+    ~print_result ~dirname:exercise_dir meta exo output_json

src/grader/grader_cli.mli

@@ -11,15 +11,6 @@
 (** Should stdout / stderr of the grader be echoed *)
 val display_std_outputs: bool ref
 
-(** Should outputs of the grader be saved and where *)
-val dump_outputs: string option ref
-
-(** Should the reports be saved and where *)
-val dump_reports: string option ref
-
-(** Should the message from 'test.ml' be displayed on stdout ? *)
-val display_callback: bool ref
-
 (** Should compiler outcome be printed ? *)
 val display_outcomes: bool ref
 
@@ -39,9 +30,14 @@ val dump_dot: string option ref
 
 (** Runs the grading process *)
 val grade:
-  ?print_result:bool -> ?dirname:string -> Learnocaml_data.Exercise.Meta.t -> Learnocaml_exercise.t -> string option ->
+  ?print_result:bool -> ?dirname:string ->
+  dump_outputs:string option -> dump_reports:string option ->
+  display_callback:bool ->
+  Learnocaml_data.Exercise.Meta.t -> Learnocaml_exercise.t -> string option ->
   (unit, int) result Lwt.t
 
 val grade_from_dir:
-  ?print_result:bool -> string -> string option ->
+  ?print_result:bool ->
+  dump_outputs:string option -> dump_reports:string option -> display_callback:bool ->
+  string -> string option ->
   (unit, int) result Lwt.t