src/import_registry.ml

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78

open Ast

module Origin_map = Map.Make (String)

type binding_origin =
  | Builtin
  | ImportedPackage of string

let metadata_key = "__tlang_internal_import_origins__"

let is_internal_key name =
  name = metadata_key

let startup_rename_warning_message () =
  String.concat "\n"
    [ "Warning: package function names may be renamed to avoid silent conflicts."
    ; "  - If an imported package conflicts with a built-in function, T keeps the built-in name"
    ; "    and renames the imported function to <package>_<function> (for example, stats_mean)."
    ; "  - If two imported user packages conflict, both functions are renamed to"
    ; "    <package>_<function> (for example, alpha_filter and beta_filter)."
    ; "These renames prevent one package from silently overwriting another."
    ]

let origin_to_string = function
  | Builtin -> "B"
  | ImportedPackage pkg -> "P" ^ pkg

let origin_of_string s =
  if s = "B" then Some Builtin
  else
    if String.length s > 1 && s.[0] = 'P' then
      Some (ImportedPackage (String.sub s 1 (String.length s - 1)))
    else
      None

let get_origins (env : environment) =
  match Env.find_opt metadata_key env with
  | Some (VDict pairs) ->
      List.fold_left
        (fun acc (name, value) ->
          match value with
          | VString encoded -> (
              match origin_of_string encoded with
              | Some origin -> Origin_map.add name origin acc
              | None -> acc)
          | _ -> acc)
        Origin_map.empty
        pairs
  | _ -> Origin_map.empty

let set_origins (env : environment) origins =
  let encoded =
    Origin_map.bindings origins
    |> List.map (fun (name, origin) -> (name, VString (origin_to_string origin)))
  in
  Env.add metadata_key (VDict encoded) env

let find_origin env name =
  Origin_map.find_opt name (get_origins env)

let set_origin env name origin =
  let origins = get_origins env |> Origin_map.add name origin in
  set_origins env origins

let remove_origin env name =
  let origins = get_origins env |> Origin_map.remove name in
  set_origins env origins

let mark_builtin_bindings env =
  let origins =
    Env.fold
      (fun name _ acc ->
        if name = metadata_key || Origin_map.mem name acc then acc
        else Origin_map.add name Builtin acc)
      env
      (get_origins env)
  in
  set_origins env origins