Skip to content

Commit f563254

Browse files
y2ky2k
committed
Add module-based namespace resolution for require with deps support
Implement new require syntax [lib.eff :as e] alongside deps declaration, enabling external package resolution via $LY2K_PACKAGES_DIR. The key fix ensures namespace hashes are computed from module names (not file paths), so call sites and definitions resolve to the same mangled identifiers.
1 parent 26eba78 commit f563254

10 files changed

Lines changed: 218 additions & 59 deletions

File tree

‎Makefile‎

Lines changed: 4 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -12,40 +12,20 @@ test_smoke: build
1212
build:
1313
@ dune build
1414

15-
# .PHONY: deploy
16-
# deploy: test_e2e deploy_force
17-
18-
# .PHONY: deploy_force
19-
# deploy_force: test_smoke
20-
# @ echo "\n>>> New ly2k version is deployed <<<\n"
21-
# @ cp -f _build/default/bin/main.exe ~/.local/bin/ly2k
22-
23-
# .PHONY: ee_test
24-
# ee_test: deploy_force
25-
# # @ dune build
26-
# @ rm -rf ~/Projects/finance_tracker/out
27-
# # @ cd ~/Projects/finance_tracker && (find . -type f -name "*.clj") | ~/Projects/language/_build/default/bin/main.exe -target eval -src ~/Documents/temp/build.clj > ~/Projects/finance_tracker/Makefile
28-
# @ cd ~/Projects/finance_tracker && ~/Projects/language/_build/default/bin/main.exe -target eval -src ~/Documents/temp/build.clj > ~/Projects/finance_tracker/Makefile
29-
3015
.PHONY: restore
3116
restore:
3217
@ dune build clj2js.opam
3318
@ opam install . --deps-only --with-test -y
3419

35-
# .PHONY: prelude
36-
# prelude:
37-
# @ dune build prelude && OCAMLRUNPARAM=b _build/default/prelude/main.exe
38-
39-
# .PHONY: test_e2e
40-
# test_e2e: test
41-
# @ cp -f _build/default/bin/main.exe _build/default/bin/clj2js
20+
.PHONY: test_e2e
21+
test_e2e: test
22+
@ $(MAKE) -C ~/Projects/declarative_ban_bot clean test
23+
@ $(MAKE) -C ~/Projects/interpreter clean test
4224
# @ PATH=$$PWD/_build/default/bin:$$PATH && $(MAKE) -C ~/Projects/repl test
43-
# @ PATH=$$PWD/_build/default/bin:$$PATH && $(MAKE) -C ~/Projects/interpreter test
4425
# @ PATH=$$PWD/_build/default/bin:$$PATH && $(MAKE) -C ~/Projects/compose_news test
4526
# @ PATH=$$PWD/_build/default/bin:$$PATH && $(MAKE) -C ~/Projects/minesweeper test
4627
# @ PATH=$$PWD/_build/default/bin:$$PATH && cd ~/Projects/finance_tracker && $(MAKE) test
4728
# @ PATH=$$PWD/_build/default/bin:$$PATH && cd ~/Projects/charge_timer && $(MAKE) test
48-
# @ PATH=$$PWD/_build/default/bin:$$PATH && $(MAKE) -C ~/Projects/declarative_ban_bot test
4929
# @ PATH=$$PWD/_build/default/bin:$$PATH && $(MAKE) -C ~/Projects/relax_cats_bot test
5030
# @ PATH=$$PWD/_build/default/bin:$$PATH && $(MAKE) -C ~/Projects/declarative_notify test e2e_test
5131

‎backend/backend_eval.ml‎

Lines changed: 24 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -34,8 +34,8 @@ let resolve_value ctx name =
3434
match List.assoc_opt name scope with
3535
| Some v -> v
3636
| None ->
37-
failwith @@ __LOC__ ^ " - Can't find value: '" ^ name ^ "' in "
38-
^ show_eval_context ctx
37+
prerr_endline @@ show_eval_context ctx;
38+
failwith @@ __LOC__ ^ " - Can't find value: '" ^ name
3939

4040
let rec eval_ (ctx : eval_context) (node : sexp) =
4141
let ctx = { ctx with level = ctx.level + 1 } in
@@ -151,25 +151,29 @@ let reg_val name value ctx = { ctx with scope = (name, value) :: ctx.scope }
151151
let reg_fun name f ctx =
152152
{ ctx with ns = (name, ref (OLambda (meta_empty, fun xs -> f xs))) :: ctx.ns }
153153

154-
let rec compile (ctx : eval_context) origin_filename log get_macro type_
155-
root_dir filename code =
154+
let rec compile (ctx : eval_context) ~deps ~current_dir ~module_name log
155+
get_macro type_ root_dir filename code =
156156
let prelude_fns = ctx.ns |> List.map fst in
157-
code
158-
|> Frontend_simplify.do_simplify ~builtin_macro:ctx.builtin_macro get_macro
159-
{ log; macro = Lazy.force Prelude.prelude_eval_macro; filename }
157+
let simplified =
158+
code
159+
|> Frontend_simplify.do_simplify ~builtin_macro:ctx.builtin_macro get_macro
160+
{ log; macro = Lazy.force Prelude.prelude_eval_macro; filename }
161+
in
162+
let deps =
163+
if deps = [] then Stage_load_require.extract_deps simplified else deps
164+
in
165+
simplified
160166
|> Stage_lint.invoke ~prelude_fns ~filename
161167
|> log_stage log (type_ ^ " Stage_lint")
162-
|> Stage_resolve_ns_legacy.do_resolve
168+
|> Stage_resolve_ns_legacy.do_resolve ~module_name
163169
(ctx.ns |> List.map fst)
164170
filename root_dir
165171
|> log_stage log (type_ ^ " Stage_resolve_ns_legacy")
166-
|> Stage_load_require.do_invoke (fun path ->
167-
let path2 =
168-
Filename.concat (Filename.dirname origin_filename) (path ^ ".clj")
169-
|> FileReader.realpath
170-
in
171-
let code = FileReader.read path2 in
172-
compile ctx origin_filename log get_macro " [REQ]" "" path2 code)
172+
|> Stage_load_require.do_invoke ~deps ~current_dir
173+
(fun ~deps ~current_dir ~module_name resolved_path ->
174+
let code = FileReader.read resolved_path in
175+
compile ctx ~deps ~current_dir ~module_name log get_macro " [REQ]" ""
176+
resolved_path code)
173177
|> log_stage log (type_ ^ " Stage_load_require")
174178
|> Stage_flat_do.invoke
175179
|> log_stage log (type_ ^ " Stage_flat_do")
@@ -181,7 +185,8 @@ let create_prelude_context ~builtin_macro =
181185
let prelude_sexp =
182186
compile
183187
(empty_eval_context ~builtin_macro)
184-
"" false (Fun.const []) "[PRELUDE]" "" "prelude.clj"
188+
~deps:[] ~current_dir:"" ~module_name:"" false (Fun.const []) "[PRELUDE]"
189+
"" "prelude.clj"
185190
(Lazy.force Prelude.prelude_eval)
186191
in
187192
empty_eval_context ~builtin_macro
@@ -195,7 +200,9 @@ let invoke ~builtin_macro (log : bool) (filename : string) code =
195200
in
196201
NameGenerator.with_scope (fun () ->
197202
let ctx = create_prelude_context ~builtin_macro in
203+
let current_dir = get_dir filename in
198204
code
199-
|> compile ctx filename log get_macro "[EVAL]" (get_dir filename) filename
205+
|> compile ctx ~deps:[] ~current_dir ~module_name:"" log get_macro
206+
"[EVAL]" current_dir filename
200207
|> eval_ ctx |> snd |> OUtils.obj_to_sexp |> Utils.serialize_to_string
201208
|> unpack_string)

‎core/common.ml‎

Lines changed: 22 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -102,17 +102,20 @@ end
102102
module FileReader = struct
103103
type _ Effect.t += Load : string -> string Effect.t
104104
type _ Effect.t += Realpath : string -> string Effect.t
105+
type _ Effect.t += FileExists : string -> bool Effect.t
105106

106107
let read filename = Effect.perform (Load filename)
107108
let realpath path = Effect.perform (Realpath path)
109+
let file_exists path = Effect.perform (FileExists path)
108110

109111
let resolve_env_in_path path =
110112
let var = ".+\\$LY2K_PACKAGES_DIR" in
111113
match Sys.getenv_opt "LY2K_PACKAGES_DIR" with
112114
| Some value -> Str.global_replace (Str.regexp var) value path
113115
| None -> path
114116

115-
let with_stub_scope (content : string) f arg =
117+
let with_stub_scope ?(file_exists = Fun.const false) (content : string) f arg
118+
=
116119
let open Effect.Deep in
117120
Effect.Deep.match_with f arg
118121
{
@@ -132,6 +135,10 @@ module FileReader = struct
132135
Str.global_replace (Str.regexp "/\\./") "/" path
133136
in
134137
continue k path)
138+
| FileExists path ->
139+
Some
140+
(fun (k : (a, _) continuation) ->
141+
continue k (file_exists path))
135142
| _ -> None);
136143
}
137144

@@ -155,6 +162,10 @@ module FileReader = struct
155162
Some
156163
(fun (k : (a, _) continuation) ->
157164
continue k (Files.realpath path))
165+
| FileExists path ->
166+
Some
167+
(fun (k : (a, _) continuation) ->
168+
continue k (Sys.file_exists path))
158169
| _ -> None);
159170
}
160171
end
@@ -365,7 +376,16 @@ end
365376
============================================================================ *)
366377

367378
module NamespaceUtils = struct
368-
let get_ns_from_path _ path = "m" ^ string_of_int (String.hash path)
379+
let normalize_path_to_module path =
380+
(* Convert file path like "lib/eff.clj" or "./lib/eff" to module name "lib.eff" *)
381+
let path = Str.global_replace (Str.regexp "\\.clj$") "" path in
382+
let path = Str.global_replace (Str.regexp "^\\./") "" path in
383+
let path = Str.global_replace (Str.regexp "\\.\\./") "" path in
384+
String.map (fun c -> if c = '/' then '.' else c) path
385+
386+
let get_ns_from_path _ path =
387+
let module_name = normalize_path_to_module path in
388+
"m" ^ string_of_int (String.hash module_name)
369389

370390
let mangle_name (ns : string) (name : string) : string =
371391
let result =

‎macro/macro.ml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ let invoke simplify (ctx : Core__.Frontend_simplify.simplify_ctx) (node : sexp)
66
: sexp option =
77
Macro_case.invoke simplify node
88
|> or_val node (Macro_cond.invoke simplify)
9+
|> or_val node (Macro_deps.invoke ctx simplify)
910
|> or_val node (Macro_fn.invoke simplify)
1011
|> or_val node Macro_gen_class.invoke
1112
|> or_val node (Macro_if_let.invoke simplify)

‎macro/macro_deps.ml‎

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
open Core__.Common
2+
3+
let invoke _ctx _simplify = function
4+
| SList (_, [ SAtom (_, "deps"); SList (_, SAtom (_, "hash-map") :: pairs) ])
5+
->
6+
let deps =
7+
pairs |> List.split_into_pairs
8+
|> List.map (fun (k, v) ->
9+
let key =
10+
match k with
11+
| SAtom (_, s) when String.starts_with ~prefix:":" s ->
12+
String.sub s 1 (String.length s - 1)
13+
| _ -> failsexp __LOC__ [ k ]
14+
in
15+
let version =
16+
match v with
17+
| SAtom (_, s) when String.starts_with ~prefix:"\"" s ->
18+
unpack_string s
19+
| _ -> failsexp __LOC__ [ v ]
20+
in
21+
SList
22+
( meta_empty,
23+
[ SAtom (meta_empty, key); SAtom (meta_empty, version) ] ))
24+
in
25+
Some
26+
(SList
27+
( meta_empty,
28+
[
29+
SAtom (meta_empty, "def*");
30+
SAtom (meta_empty, "__deps");
31+
SList
32+
( meta_empty,
33+
[ SAtom (meta_empty, "quote*"); SList (meta_empty, deps) ] );
34+
] ))
35+
| _ -> None

‎macro/macro_ns.ml‎

Lines changed: 17 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,15 +1,29 @@
11
open Core__.Common
22

3-
let convert_path_to_ns filename path =
4-
Filename.concat (Filename.dirname filename) (path ^ ".clj")
5-
|> FileReader.realpath |> String.hash |> Printf.sprintf "m%i"
3+
let module_to_path module_name =
4+
String.split_on_char '.' module_name |> String.concat Filename.dir_sep
5+
6+
let convert_path_to_ns _filename path = "m" ^ string_of_int (String.hash path)
67

78
type ns_ctx = { filename : string; namespace : string }
89

910
let expand_require ctx requires =
1011
let aliases =
1112
requires
1213
|> List.concat_map (function
14+
(* New format: [lib.eff :as e] - path is a symbol with dots *)
15+
| SList (_, [ _; SAtom (_, path); SAtom (_, ":as"); SAtom (ma, alias) ])
16+
when not (String.starts_with ~prefix:"\"" path) ->
17+
[
18+
SAtom (meta_empty, alias);
19+
SList
20+
( meta_empty,
21+
[
22+
SAtom (ma, convert_path_to_ns ctx.filename path);
23+
SAtom (ma, path);
24+
] );
25+
]
26+
(* Old format: ["./lib/eff" :as e] - path is a quoted string *)
1327
| SList (_, [ _; SAtom (_, path); SAtom (_, ":as"); SAtom (ma, alias) ])
1428
->
1529
let path2 = unpack_string path in

‎stage/stage_load_require.ml‎

Lines changed: 83 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,70 @@
11
open Core__.Common
22

3-
type options = { compile : string -> sexp }
3+
type deps = (string * string) list
4+
5+
type options = {
6+
compile :
7+
deps:deps -> current_dir:string -> module_name:string -> string -> sexp;
8+
deps : deps;
9+
current_dir : string;
10+
}
11+
412
type context = { opt : options }
513

14+
let module_to_path module_name =
15+
String.split_on_char '.' module_name |> String.concat Filename.dir_sep
16+
17+
let get_root_module module_name =
18+
match String.split_on_char '.' module_name with
19+
| root :: _ -> root
20+
| [] -> module_name
21+
22+
let resolve_module_path ~deps ~current_dir module_name =
23+
let relative_path = module_to_path module_name in
24+
let local_path = Filename.concat current_dir (relative_path ^ ".clj") in
25+
if FileReader.file_exists local_path then FileReader.realpath local_path
26+
else
27+
let root_module = get_root_module module_name in
28+
match List.assoc_opt root_module deps with
29+
| Some version ->
30+
let packages_dir =
31+
match Sys.getenv_opt "LY2K_PACKAGES_DIR" with
32+
| Some dir -> dir
33+
| None -> failwith "LY2K_PACKAGES_DIR environment variable is not set"
34+
in
35+
let pkg_path =
36+
Printf.sprintf "%s/%s/%s/%s.clj" packages_dir root_module version
37+
relative_path
38+
in
39+
if FileReader.file_exists pkg_path then pkg_path
40+
else
41+
failwith
42+
(Printf.sprintf "Module not found in package: %s at %s" module_name
43+
pkg_path)
44+
| None ->
45+
failwith
46+
(Printf.sprintf "Module not found: %s (checked: %s)" module_name
47+
local_path)
48+
49+
let extract_deps node =
50+
let rec find_deps = function
51+
| SAtom _ -> []
52+
| SList (_, SAtom (_, "do*") :: children) ->
53+
List.concat_map find_deps children
54+
| SList
55+
( _,
56+
SAtom (_, "def*")
57+
:: SAtom (_, "__deps")
58+
:: SList (_, [ SAtom (_, "quote*"); SList (_, items) ])
59+
:: _ ) ->
60+
items
61+
|> List.map (function
62+
| SList (_, [ SAtom (_, name); SAtom (_, version) ]) -> (name, version)
63+
| x -> failsexp __LOC__ [ x ])
64+
| SList _ -> []
65+
in
66+
find_deps node
67+
668
let rec invoke (ctx : context) = function
769
| SAtom _ as x -> (ctx, x)
870
| SList (m, (SAtom (_, "do*") as do_) :: children) ->
@@ -17,7 +79,24 @@ let rec invoke (ctx : context) = function
1779
let items =
1880
items |> List.split_into_pairs
1981
|> List.map (function
20-
| _, SList (_, [ _; SAtom (_, path); _ ]) -> ctx.opt.compile path
82+
(* New format: 2 elements - [ns_id, module_path] *)
83+
| _, SList (_, [ _; SAtom (_, module_name) ]) ->
84+
let resolved_path =
85+
resolve_module_path ~deps:ctx.opt.deps
86+
~current_dir:ctx.opt.current_dir module_name
87+
in
88+
let new_current_dir = Filename.dirname resolved_path in
89+
ctx.opt.compile ~deps:ctx.opt.deps ~current_dir:new_current_dir
90+
~module_name resolved_path
91+
(* Old format: 3 elements - [ns_id, path_unquoted, path_quoted] *)
92+
| _, SList (_, [ _; SAtom (_, path); _ ]) ->
93+
let resolved_path =
94+
resolve_module_path ~deps:ctx.opt.deps
95+
~current_dir:ctx.opt.current_dir path
96+
in
97+
let new_current_dir = Filename.dirname resolved_path in
98+
ctx.opt.compile ~deps:ctx.opt.deps ~current_dir:new_current_dir
99+
~module_name:path resolved_path
21100
| k, v -> failsexp __LOC__ [ k; v ])
22101
in
23102
(ctx, SList (meta_empty, SAtom (meta_empty, "do*") :: items))
@@ -28,5 +107,5 @@ let rec invoke (ctx : context) = function
28107
| SList (_, _ :: _) as x -> (ctx, x)
29108
| x -> failsexp __LOC__ [ x ]
30109

31-
let do_invoke compile (node : sexp) : sexp =
32-
invoke { opt = { compile } } node |> snd
110+
let do_invoke ~deps ~current_dir compile (node : sexp) : sexp =
111+
invoke { opt = { compile; deps; current_dir } } node |> snd

0 commit comments

Comments
 (0)