refactoring

clj2js/.ocamlformat

@@ -1 +1,2 @@
 profile = default
+margin = 120

clj2js/Makefile

@@ -17,9 +17,9 @@ restore:
 .PHONY: test_e2e
 test_e2e: test
 	@ cp -f _build/default/bin/main.exe _build/default/bin/clj2js
+	@ PATH=$$PWD/_build/default/bin:$$PATH && $(MAKE) -C ~/Projects/charge_timer build PRELUDE_JS_PATH=$(PRELUDE_PATH) PRELUDE_JAVA_PATH=$(PRELUDE_JAVA_PATH)
 	@ PATH=$$PWD/_build/default/bin:$$PATH && $(MAKE) -C ~/Projects/interpreter test PRELUDE_PATH=$(PRELUDE_JAVA_DIR)
-	@ PATH=$$PWD/_build/default/bin:$$PATH && $(MAKE) -C ~/Projects/finance_tracker build_java test PRELUDE_PATH=$(PRELUDE_PATH) ANDROID_PRELUDE_PATH=$(PRELUDE_JAVA_PATH)
-	@ PATH=$$PWD/_build/default/bin:$$PATH && $(MAKE) -C ~/Projects/charge_timer build_java build_resources build_dex PRELUDE_JS_PATH=$(PRELUDE_PATH) PRELUDE_JAVA_PATH=$(PRELUDE_JAVA_PATH)
+	@ PATH=$$PWD/_build/default/bin:$$PATH && $(MAKE) -C ~/Projects/finance_tracker test PRELUDE_PATH=$(PRELUDE_PATH) ANDROID_PRELUDE_PATH=$(PRELUDE_JAVA_PATH)
 	@ PATH=$$PWD/_build/default/bin:$$PATH && $(MAKE) -C ~/Projects/declarative_ban_bot/ test PRELUDE_PATH=$(PRELUDE_PATH)
 	@ PATH=$$PWD/_build/default/bin:$$PATH && $(MAKE) -C ~/Projects/relax_cats_bot/.github/ test PRELUDE_PATH=$(PRELUDE_PATH)
 	@ PATH=$$PWD/_build/default/bin:$$PATH && $(MAKE) -C ~/Projects/declarative_notify/.github test e2e_test PRELUDE_PATH=$(PRELUDE_PATH)

clj2js/bin/build_script.ml

@@ -1,4 +1,10 @@
-(* /Users/igor/Projects/interpreter *)
+module Atomic = struct
+  include Atomic
+
+  let rec swap a f =
+    let old_v = Atomic.get a in
+    if Atomic.compare_and_set a old_v (f old_v) then () else swap a f
+end
 
 let reduce_files dir acc f =
   let rec reduce_files2 dir prefix acc f =
@@ -31,75 +37,95 @@ let filter_source_file path =
 let change_extension path ext = Filename.chop_extension path ^ ext
 
 let convert_clj_filename_to_java path =
-  match Filename.dirname path with
-  | "." -> String.capitalize_ascii path
-  | dir ->
-      Filename.basename path |> String.capitalize_ascii |> Filename.concat dir
+  match Filename.dirname path with "." -> path | dir -> Filename.basename path |> Filename.concat dir
+
+let get_lib_pkg_name lib file =
+  let parts = String.split_on_char '/' lib in
+  let a = List.find_index (( = ) "packages") parts |> Option.get in
+  let start_pkg = List.nth parts (a + 1) in
+
+  match String.rindex_opt file '/' with
+  | None -> start_pkg
+  | Some b ->
+      let end_pkg = String.sub file 0 b in
+      start_pkg ^ "." ^ end_pkg
 
-let make_copy_libs target libs =
-  libs
-  |> List.concat_map (fun lib ->
-         let path_parts = String.split_on_char '/' lib in
-         let lib_name = List.nth path_parts (List.length path_parts - 3) in
-         let target_lib_path = target ^ "/" ^ lib_name in
-         let complie_commands =
-           reduce_files lib [] (fun acc file -> file :: acc)
-           |> List.map (fun file ->
-                  Printf.sprintf "clj2js java %s $FULL_PRELUDE_JAVA > %s"
-                    (Filename.concat lib file)
-                    (Filename.concat target_lib_path
-                       (change_extension file ".java")))
-         in
-         [
-           Printf.sprintf "mkdir -p %s" target_lib_path;
-           (* Printf.sprintf "cp -r %s %s" lib target_lib_path; *)
-         ]
-         @ complie_commands)
+let make_copy_libs lang target =
+  List.concat_map (fun lib ->
+      let path_parts = String.split_on_char '/' lib in
+      let lib_name = List.nth path_parts (List.length path_parts - 3) in
+      let target_lib_path = target ^ "/" ^ lib_name in
+      reduce_files lib [] (fun acc file -> file :: acc)
+      |> List.concat_map (fun file ->
+             (* prerr_endline @@ "LOG: " ^ lib ^ " | " ^ file; *)
+             let target_file = Filename.concat target_lib_path (change_extension file ("." ^ lang)) in
+             let target_file = Filename.concat (Sys.getcwd ()) target_file in
+             [
+               Printf.sprintf "mkdir -p %s" (Filename.dirname target_file);
+               Printf.sprintf "clj2js %s %s $FULL_PRELUDE_PATH %s > %s" lang (Filename.concat lib file)
+                 (get_lib_pkg_name lib file) target_file;
+             ]))
 
-let make_build_script_ source_path target_path libs =
+let compute_package_name source_path file =
+  (* prerr_endline @@ "LOG: " ^ source_path ^ " | " ^ file; *)
+  match String.rindex_opt source_path '/' with
+  | None -> source_path
+  | Some a -> (
+      let a = a + 1 in
+      let start_pkg = String.sub source_path a (String.length source_path - a) in
+      match String.rindex_opt file '/' with
+      | None -> start_pkg
+      | Some b ->
+          let end_pkg = String.sub file 0 b in
+          start_pkg ^ "." ^ end_pkg)
+
+let make_build_script_ lang source_path target_path libs =
   (* print_endline @@ path ^ " | " ^ target_path; *)
-  let result =
-    reduce_files source_path [] (fun acc file ->
-        if filter_source_file file then file :: acc else acc)
-  in
+  let result = reduce_files source_path [] (fun acc file -> if filter_source_file file then file :: acc else acc) in
   List.concat
     [
-      make_copy_libs target_path libs;
+      make_copy_libs lang target_path libs;
       [ "" ];
       result
       |> List.map (fun file ->
              let target_file =
                Filename.concat
                  (Filename.concat target_path (Filename.basename source_path))
-                 (change_extension (convert_clj_filename_to_java file) ".java")
+                 (change_extension (convert_clj_filename_to_java file) ("." ^ lang))
              in
+             let target_file = Filename.concat (Sys.getcwd ()) target_file in
              (* *)
-             let create_dir =
-               Printf.sprintf "mkdir -p %s" (Filename.dirname target_file)
-             in
-             Printf.sprintf "%s\nclj2js java %s $FULL_PRELUDE_JAVA > %s"
-               create_dir
-               (Filename.concat source_path file)
-               target_file);
+             let pkg_name = compute_package_name source_path file in
+             String.concat "\n"
+               [
+                 Printf.sprintf "mkdir -p %s" (Filename.dirname target_file);
+                 Printf.sprintf "clj2js %s %s $FULL_PRELUDE_PATH %s > %s" lang
+                   (Filename.concat (Filename.concat (Sys.getcwd ()) source_path) file)
+                   pkg_name target_file;
+               ]);
     ]
   |> List.fold_left (Printf.sprintf "%s\n%s")
        (Printf.sprintf
           "#!/bin/bash\n\
            set -e\n\
            set -u\n\
            set -o pipefail\n\n\
-           export FULL_PRELUDE_JAVA=$(realpath $PRELUDE_JAVA)/prelude.clj\n")
+           export OCAMLRUNPARAM=b\n\
+           export FULL_PRELUDE_PATH=$(realpath $PRELUDE_%s)\n"
+          (String.uppercase_ascii lang))
   |> print_endline
 
 let make_build_script () =
-  let path = ref "" in
+  let pathes = Atomic.make [] in
   let target_path = ref "" in
   let libs = ref [] in
+  let lang = ref "java" in
   Arg.parse
     [
-      ("-path", Arg.Set_string path, "Path to clj files root");
+      ("-path", Arg.String (fun x -> Atomic.swap pathes (fun l -> x :: l)), "Path to clj files root");
       ("-lib", Arg.String (fun x -> libs := x :: !libs), "Dependency path");
       ("-target", Arg.Set_string target_path, "Target path");
+      ("-lang", Arg.Set_string lang, "Language (default: java, options: java, js)");
     ]
     ignore "";
-  make_build_script_ !path !target_path !libs
+  List.iter (fun path -> make_build_script_ !lang path !target_path !libs) (Atomic.get pathes)

clj2js/bin/main.ml

@@ -28,7 +28,10 @@ let combile_file () =
             Clj2js.main_js_with_strict false filename prelude
         | "java" ->
             let prelude = read_code_file Sys.argv.(3) in
-            Clj2js.main_java false filename prelude
+            (* Clj2js.main_java Sys.argv.(4) false filename prelude *)
+            Clj2js.main_java
+              (match Sys.argv with [| _; _; _; _; x |] -> x | _ -> "")
+              false filename prelude
         | "bytecode" ->
             let prelude = read_code_file Sys.argv.(3) in
             Clj2js.main_bytecode false filename prelude

clj2js/lib/backend_java.ml

@@ -76,13 +76,7 @@ let generate_class (compile_exp : cljexp -> string) prefix params clsName
      %s%s}"
     clsName superCls state ms
 
-let pkg_name_from_file_name (context : context) =
-  prerr_endline @@ context.filename;
-  let start = String.index context.filename '/' + 1 in
-  context.filename
-  |> StringLabels.sub ~pos:start ~len:(String.length context.filename - start)
-  |> String.map (function '/' -> '.' | x -> x)
-  |> fun s -> StringLabels.sub ~pos:0 ~len:(String.length s - 4) s
+let pkg_name_from_file_name (context : context) = context.base_ns
 
 let rec compile_ (context : context) (node : cljexp) : context * string =
   let compile node = compile_ context node |> snd in
@@ -177,7 +171,7 @@ let rec compile_ (context : context) (node : cljexp) : context * string =
           (String.length context.filename - name_start_pos)
       in
       let cls_name =
-        String.capitalize_ascii (String.sub filename 0 1)
+        String.sub filename 0 1
         ^ String.sub filename 1 (String.length filename - 5)
         |> String.map (function '.' -> '_' | x -> x)
       in
@@ -209,8 +203,8 @@ let rec compile_ (context : context) (node : cljexp) : context * string =
              | n -> failnode __LOC__ [ n ])
         |> List.fold_left (Printf.sprintf "%s%s") ""
       in
-      let name = pkg_name_from_file_name context in
-      Printf.sprintf "package %s;\n%s" name imports |> with_context
+      let pkg_name = pkg_name_from_file_name context in
+      Printf.sprintf "package %s;\n%s" pkg_name imports |> with_context
   | RBList (Atom (_, "do*") :: body) ->
       let js_body =
         body |> List.map compile
@@ -363,15 +357,16 @@ let rec compile_ (context : context) (node : cljexp) : context * string =
       fname ^ "(" ^ sargs ^ ")" |> with_context
   | n -> failnode __LOC__ [ n ]
 
-let main (log : bool) (filename : string) prelude_macros code =
+let main base_ns (log : bool) (filename : string) prelude_macros code =
   let macros_ctx, _macro_sexp =
     prelude_macros
     |> Frontend.parse_and_simplify
          { empty_context with interpreter = Backend_interpreter.interpret }
          "prelude"
   in
   let ctx, node =
-    code |> Frontend.parse_and_simplify { macros_ctx with log } filename
+    code
+    |> Frontend.parse_and_simplify { macros_ctx with log; base_ns } filename
   in
   node
   |> try_log "parse_and_simplify      ->" log
@@ -380,7 +375,7 @@ let main (log : bool) (filename : string) prelude_macros code =
   |> Stage_normalize_bracket.invoke
   |> try_log "Stage_normalize_bracket ->" log
   |> Stage_linter.invoke ctx _macro_sexp
-  |> Stage_java_require.main
+  |> Stage_java_require.main ctx
   |> try_log "Stage_java_require      ->" log
   |> Stage_convert_if_to_statment.invoke
   |> try_log "Stage_a_normal_form     ->" log

clj2js/lib/common.ml

@@ -40,6 +40,7 @@ type context = {
   scope : (cljexp * context) StringMap.t;
   prelude_scope : unit StringMap.t;
   interpreter : context -> cljexp -> context * cljexp;
+  base_ns : string;
 }
 [@@deriving show]
 
@@ -56,6 +57,7 @@ let empty_context =
     scope = StringMap.empty;
     prelude_scope = StringMap.empty;
     interpreter = (fun _ _ -> failwith __LOC__);
+    base_ns = "";
   }
 
 module NameGenerator = struct

clj2js/lib/dune

@@ -1,5 +1,5 @@
 (library
  (name lib)
- (libraries angstrom yojson ppx_deriving_yojson.runtime)
+ (libraries angstrom yojson ppx_deriving_yojson.runtime unix)
  (preprocess
   (pps ppx_deriving.show ppx_deriving_yojson)))

clj2js/lib/lib.ml

@@ -5,8 +5,8 @@ let main_js_with_strict log (filename : string) (prelude_macros : string) code =
   main_js log filename prelude_macros code
   |> Printf.sprintf "\"use strict\";\n%s"
 
-let main_java log (filename : string) (prelude_macros : string) code =
-  Backend_java.main log filename prelude_macros code
+let main_java (base_ns : string) log (filename : string) (prelude_macros : string) code =
+  Backend_java.main base_ns log filename prelude_macros code
 
 let main_bytecode log (filename : string) (prelude_macros : string) code =
   Backend_bytecode.main log filename prelude_macros code

clj2js/lib/stage_java_require.ml

@@ -1,16 +1,39 @@
 open Common
 
-type inner_context = { requires : string StringMap.t } [@@deriving show]
+type inner_context = { requires : string StringMap.t; context : context }
+[@@deriving show]
 
-let fix_name { requires } name =
+let merge_packages (context : context) (rel_ns : string) =
+  let rec loop xs ps =
+    (* prerr_endline @@ "LOG3: " ^ String.concat "," (xs @ ps); *)
+    match (xs, ps) with
+    | _ :: xs, ".." :: ps -> loop xs ps
+    | xs, "." :: ps -> loop xs ps
+    | xs, ps -> List.rev xs @ ps
+  in
+  loop
+    (String.split_on_char '.' context.base_ns |> List.rev)
+    (String.split_on_char '/' rel_ns)
+  |> String.concat "."
+
+let fix_name { requires; context } name =
+  (* prerr_endline @@ "LOG: " ^ name ^ " " ^ show_inner_context { requires }; *)
   match String.index_opt name '/' with
   | None -> name
   | Some i -> (
       let alias = String.sub name 0 i in
       match StringMap.find_opt alias requires with
       | None -> name
-      | Some full_name -> full_name ^ String.sub name i (String.length name - i)
-      )
+      | Some full_name ->
+          let f_name = String.sub name (i + 1) (String.length name - i - 1) in
+          let a = String.sub full_name 1 (String.length full_name - 2) in
+          (* print_endline @@ "LOG1: " ^ a ^ " | " ^ name; *)
+          let b = merge_packages context a in
+          let c = b |> String.map (function '/' -> '.' | x -> x) in
+          (* print_endline @@ "LOG2: " ^ a ^ " | " ^ b ^ " | " ^ c; *)
+          (* *)
+          (* full_name ^ String.sub name i (String.length name - i)) *)
+          c ^ "." ^ f_name)
 
 let rec invoke (ctx : inner_context) (node : cljexp) : inner_context * cljexp =
   match node with
@@ -34,6 +57,7 @@ let rec invoke (ctx : inner_context) (node : cljexp) : inner_context * cljexp =
                       match x with
                       | SBList [ Atom (_, full_name); _; Atom (_, alias) ] ->
                           {
+                            ctx with
                             requires =
                               StringMap.add alias full_name ctx.requires;
                           }
@@ -76,6 +100,6 @@ let rec invoke (ctx : inner_context) (node : cljexp) : inner_context * cljexp =
       print_endline @@ show_inner_context ctx;
       failnode __LOC__ [ n ]
 
-let main (node : cljexp) : cljexp =
-  let _, node = invoke { requires = StringMap.empty } node in
+let main (context : context) (node : cljexp) : cljexp =
+  let _, node = invoke { requires = StringMap.empty; context } node in
   node

clj2js/test/samples/input/samples.bytecode.txt

@@ -14,6 +14,7 @@
 (let [x (foo)] x)
 (list 1 2 3)
 (not= 1 2)
+(ns _ (:require ["./b/c" :as b]) (:require ["../a/b" :as f])) (defn foo [] (b/mb 1 2) (f/mf 3 4))
 (ns bar) (defn foo [a b] (+ a b))
 (vector 1 2 3)
 {:k1 1 :k2 "v2" "k3" :v3}

clj2js/test/samples/output/samples.bytecode.txt

@@ -252,6 +252,26 @@ not
 =============================
 (
 def*
+_/foo
+(
+fn*
+(
+)
+(
+_/b/mb
+1
+2
+)
+(
+_/f/mf
+3
+4
+)
+)
+)
+=============================
+(
+def*
 bar/foo
 (
 fn*