primus lisp programmatic loading in bap

dune

(executable
(name main)
;(modes byte js)
(flags -linkall -g)
; with dune build main.bc.js --release
; gets us to the Sys flushed error.
(js_of_ocaml (flags --toplevel --dynlink +toplevel.js +dynlink.js --disable inline --pretty --source-map-inline
--file /home/philip/.opam/bapjs/lib/bap/bil.plugin
--file /home/philip/.opam/bapjs/lib/bap/primus_lisp.plugin
--file /home/philip/Documents/ocaml/bapjs2/staticload/test.lisp
--file /home/philip/.opam/bapjs/share/bap/primus/lisp/core.lisp
--file /home/philip/.opam/bapjs/share/bap/primus/lisp/init.lisp
--file /home/philip/.opam/bapjs/share/bap/primus/lisp/memory.lisp
--file /home/philip/.opam/bapjs/share/bap/primus/lisp/pointers.lisp
)
(javascript_files helpers.js)
)
(libraries bap bap-primus zarith_stubs_js 
; comment out for main.bc build
;js_of_ocaml-toplevel js_of_ocaml-ppx
)
;(preprocess (pps js_of_ocaml-ppx))
)

main.ml

open Core_kernel
open Bap_primus.Std
open Bap.Std
open Bap_knowledge
open Bap_core_theory
include Self()
module KB = Knowledge
open KB.Syntax

let load_program paths features project =
  match Primus.Lisp.Load.program ~paths project features with
  | Ok prog -> prog
  | Error err ->
    let err = Format.asprintf "%a" Primus.Lisp.Load.pp_error err in
    invalid_arg err

let (:=) p x v = KB.Value.put p v x
let empty = KB.Value.empty Theory.Source.cls
let pack prog = List.fold ~init:empty [
  Theory.Source.language := Primus.Lisp.Unit.language;
  Primus.Lisp.Semantics.program := prog;
] ~f:(|>)

let show target paths feat name =
  Toplevel.try_exec @@ begin
    Primus.Lisp.Unit.create target >>= fun unit ->
      let prog = pack @@ load_program paths feat @@
      Project.empty target in
      KB.provide Theory.Unit.source unit prog >>= fun () ->
    KB.Object.scoped Theory.Program.cls @@ fun obj ->
    KB.sequence [
      KB.provide Theory.Label.unit obj (Some unit);
      KB.provide Primus.Lisp.Semantics.name obj (Some name);
    ] >>= fun () ->
    KB.collect Theory.Semantics.slot obj >>| fun sema ->
    Format.eprintf "%a@." KB.Value.pp sema
  end

let () = match Bap_main.init
~log:(`Formatter Format.std_formatter) ~err:Format.std_formatter
 with
    | Ok () -> ()
    | Error err -> Bap_main.Extension.Error.pp Format.std_formatter err
module Configuration = Bap_main.Extension.Configuration
let is_folder p = Sys.file_exists p && Sys.is_directory p
let library_paths =
  let (/) = Filename.concat in Configuration.[
      datadir / "primus" / "lisp";
      sysdatadir / "primus" / "site-lisp";
      sysdatadir / "primus" / "lisp";
    ] |> List.filter ~f:is_folder

let () = match show Theory.Target.unknown (library_paths @ ["."]) ["core"; "mytest"] (KB.Name.create "foo") with
      | Ok () -> ()
      | Error err -> (KB.Conflict.pp Format.std_formatter err); failwith "failed"

mytest.lisp

(defun foo (x) (set x (+ x 3)))