Skip to content

Commit

Permalink
migrate job_directory to runtime_config, and delete OptionState
Browse files Browse the repository at this point in the history
  • Loading branch information
gfngfn committed Oct 30, 2023
1 parent fed99e2 commit 4c8a575
Show file tree
Hide file tree
Showing 14 changed files with 111 additions and 83 deletions.
31 changes: 0 additions & 31 deletions src/backend/optionState.ml

This file was deleted.

10 changes: 0 additions & 10 deletions src/backend/optionState.mli

This file was deleted.

3 changes: 1 addition & 2 deletions src/frontend/bytecomp/bytecomp.ml
Original file line number Diff line number Diff line change
Expand Up @@ -15,8 +15,7 @@ let compile_and_exec_0 (env : environment) (ast : abstract_tree) : syntactic_val


let compile_environment (env : environment) : unit =
let (binds, _) = env in
binds |> EvalVarIDMap.iter (fun _evid loc ->
env.env_main |> EvalVarIDMap.iter (fun _evid loc ->
match !loc with
| PrimitiveClosure(parbr, _env1, arity, astf) ->
begin
Expand Down
4 changes: 2 additions & 2 deletions src/frontend/bytecomp/ir.cppo.ml
Original file line number Diff line number Diff line change
Expand Up @@ -127,7 +127,7 @@ and transform_1_math_text_content (_env : frame) (_ims : math_text_element list)


and transform_ast_0 (env : environment) (ast : abstract_tree) : ir * environment =
let (genv, _) = env in
let genv = env.env_main in
let initvars =
EvalVarIDMap.fold (fun k v acc ->
EvalVarIDMap.add k (GlobalVar(v, k, ref 0)) acc
Expand All @@ -139,7 +139,7 @@ and transform_ast_0 (env : environment) (ast : abstract_tree) : ir * environment


and transform_ast_1 (env : environment) (ast : abstract_tree) : ir * environment =
let (genv, _) = env in
let genv = env.env_main in
let initvars =
EvalVarIDMap.fold (fun k v acc ->
EvalVarIDMap.add k (GlobalVar(v, k, ref 0)) acc
Expand Down
5 changes: 5 additions & 0 deletions src/frontend/bytecomp/vm.cppo.ml
Original file line number Diff line number Diff line change
Expand Up @@ -74,6 +74,11 @@ let lex_horz_text (ctx : HorzBox.context_main) (s_utf8 : string) : HorzBox.horz_
HorzBox.([ HorzPure(PHCInnerString{ context = ctx; chars = uchlst }) ])


let get_runtime_config (env : vmenv) : runtime_config =
let (global, _) = env in
global.env_config


let popn (stack : stack) (n : int) : syntactic_value list * stack =
let rec iter st n acc =
if n = 0 then
Expand Down
4 changes: 4 additions & 0 deletions src/frontend/evaluator.cppo.ml
Original file line number Diff line number Diff line change
Expand Up @@ -42,6 +42,10 @@ let find_symbol (env : environment) (evid : EvalVarID.t) : CodeSymbol.t option =
None


let get_runtime_config (env : environment) : runtime_config =
env.env_config


let generate_symbol_for_eval_var_id (evid : EvalVarID.t) (env : environment) : environment * CodeSymbol.t =
let symb =
let varnm = EvalVarID.get_varnm evid in
Expand Down
64 changes: 48 additions & 16 deletions src/frontend/main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -32,7 +32,7 @@ let reset (output_mode : output_mode) =


(* Initialization that should be performed before typechecking *)
let initialize ~(is_bytecomp_mode : bool) (output_mode : output_mode) : Typeenv.t * environment =
let initialize ~(is_bytecomp_mode : bool) (output_mode : output_mode) (runtime_config : runtime_config) : Typeenv.t * environment =
FreeID.initialize ();
BoundID.initialize ();
EvalVarID.initialize ();
Expand All @@ -41,9 +41,9 @@ let initialize ~(is_bytecomp_mode : bool) (output_mode : output_mode) : Typeenv.
let res =
match output_mode with
| TextMode(_) ->
Primitives.make_text_mode_environments ()
Primitives.make_text_mode_environments runtime_config
| PdfMode ->
Primitives.make_pdf_mode_environments ()
Primitives.make_pdf_mode_environments runtime_config
in
let (tyenv, env) =
match res with
Expand All @@ -62,24 +62,52 @@ let initialize ~(is_bytecomp_mode : bool) (output_mode : output_mode) : Typeenv.
module StoreIDMap = Map.Make(StoreID)


type frozen_environment = location EvalVarIDMap.t * (syntactic_value StoreIDHashTable.t) ref * syntactic_value StoreIDMap.t
type frozen_environment = {
frozen_main : location EvalVarIDMap.t;
frozen_store_ref : (syntactic_value StoreIDHashTable.t) ref;
frozen_store_map : syntactic_value StoreIDMap.t;
frozen_config : runtime_config;
}


let freeze_environment (env : environment) : frozen_environment =
let (valenv, stenvref) = env in
let
{
env_main = valenv;
env_store = stenvref;
env_config = runtime_config;
} = env
in
let stmap =
StoreIDMap.empty |> StoreIDHashTable.fold (fun stid value stmap ->
stmap |> StoreIDMap.add stid value
) (!stenvref)
in
(valenv, stenvref, stmap)


let unfreeze_environment ((valenv, stenvref, stmap) : frozen_environment) : environment =
{
frozen_main = valenv;
frozen_store_ref = stenvref;
frozen_store_map = stmap;
frozen_config = runtime_config;
}


let unfreeze_environment (frenv : frozen_environment) : environment =
let
{
frozen_main = valenv;
frozen_store_ref = stenvref;
frozen_store_map = stmap;
frozen_config = runtime_config;
} = frenv
in
let stenv = StoreIDHashTable.create 128 in
stmap |> StoreIDMap.iter (fun stid value -> StoreIDHashTable.add stenv stid value);
stenvref := stenv;
(valenv, ref stenv)
{
env_main = valenv;
env_store = ref stenv;
env_config = runtime_config;
}


let output_pdf (pdfret : HandlePdf.t) : unit =
Expand Down Expand Up @@ -1608,6 +1636,10 @@ let load_package (display_config : Logging.config) ~(use_test_files : bool) ~(ex
| Error(e) -> raise (ConfigError(e))


let get_job_directory (abspath : abs_path) : string =
Filename.dirname (get_abs_path_string abspath)


let build
~(fpath_in : string)
~(fpath_out_opt : string option)
Expand All @@ -1629,6 +1661,7 @@ let build
let curdir = Sys.getcwd () in

let input_file = make_absolute_if_relative ~origin:curdir fpath_in in
let job_directory = get_job_directory input_file in
let output_file = fpath_out_opt |> Option.map (make_absolute_if_relative ~origin:curdir) in
let extra_config_paths = config_paths_str_opt |> Option.map (String.split_on_char ':') in
let output_mode = make_output_mode text_mode_formats_str_opt in
Expand All @@ -1649,7 +1682,7 @@ let build
debug_show_overfull;
}
in
OptionState.set OptionState.{ input_file = Some(input_file) };
let runtime_config = { job_directory } in

let library_root = setup_root_dirs ~no_default_config ~extra_config_paths curdir in
let abspath_in = input_file in
Expand Down Expand Up @@ -1688,7 +1721,7 @@ let build
in

let extensions = get_candidate_file_extensions output_mode in
let (tyenv_prim, env) = initialize ~is_bytecomp_mode output_mode in
let (tyenv_prim, env) = initialize ~is_bytecomp_mode output_mode runtime_config in

match build_input with
| PackageBuildInput{
Expand Down Expand Up @@ -1770,6 +1803,7 @@ let test
let curdir = Sys.getcwd () in

let input_file_to_test = make_absolute_if_relative ~origin:curdir fpath_in in
let job_directory = get_job_directory input_file_to_test in
let extra_config_paths = config_paths_str_opt |> Option.map (String.split_on_char ':') in
let output_mode_to_test = make_output_mode text_mode_formats_str_opt in
let bytecomp = false in
Expand All @@ -1781,7 +1815,7 @@ let test
| TextMode(_) -> true
}
in
OptionState.set OptionState.{ input_file = Some(input_file_to_test) };
let runtime_config = { job_directory } in

let library_root = setup_root_dirs ~no_default_config ~extra_config_paths curdir in
let abspath_in = input_file_to_test in
Expand Down Expand Up @@ -1810,7 +1844,7 @@ let test
in

let extensions = get_candidate_file_extensions output_mode_to_test in
let (tyenv_prim, env) = initialize ~is_bytecomp_mode:bytecomp output_mode_to_test in
let (tyenv_prim, env) = initialize ~is_bytecomp_mode:bytecomp output_mode_to_test runtime_config in

begin
match test_input with
Expand Down Expand Up @@ -1997,8 +2031,6 @@ let solve

let extra_config_paths = config_paths_str_opt |> Option.map (String.split_on_char ':') in

OptionState.set OptionState.{ input_file = None };

let library_root = setup_root_dirs ~no_default_config ~extra_config_paths curdir in
let abspath_in = make_absolute_if_relative ~origin:curdir fpath_in in
let solve_input =
Expand Down
18 changes: 12 additions & 6 deletions src/frontend/primitives.cppo.ml
Original file line number Diff line number Diff line change
Expand Up @@ -727,13 +727,19 @@ let text_mode_table =
]


let make_environments table =
let make_environments (runtime_config : runtime_config) table =
let tyenv =
Typeenv.empty
|> add_general_default_types
|> add_pdf_mode_default_types
in
let env : environment = (EvalVarIDMap.empty, ref (StoreIDHashTable.create 128)) in
let env : environment =
{
env_main = EvalVarIDMap.empty;
env_store = ref (StoreIDHashTable.create 128);
env_config = runtime_config;
}
in
let temporary_ast = Nil in
let (tyenv, env, locacc) =
table |> List.fold_left (fun (tyenv, env, acc) (varnm, pty, deff) ->
Expand All @@ -760,14 +766,14 @@ let resolve_lib_file (libpath : lib_path) =
|> Result.map_error (fun candidates -> CannotFindLibraryFile(libpath, candidates))


let make_pdf_mode_environments () =
let make_pdf_mode_environments (runtime_config : runtime_config) =
let open ResultMonad in
let* abspath_hyphen = resolve_lib_file (make_lib_path "hyph/english.satysfi-hyph") in
default_hyphen_dictionary := LoadHyph.main abspath_hyphen;
(* TODO: should depend on the current language *)
return @@ make_environments pdf_mode_table
return @@ make_environments runtime_config pdf_mode_table


let make_text_mode_environments () =
let make_text_mode_environments (runtime_config : runtime_config) =
let open ResultMonad in
return @@ make_environments text_mode_table
return @@ make_environments runtime_config text_mode_table
4 changes: 2 additions & 2 deletions src/frontend/primitives.mli
Original file line number Diff line number Diff line change
Expand Up @@ -10,8 +10,8 @@ val itemize_type : unit -> ('a, 'b) typ

val get_pdf_mode_initial_context : length -> HorzBox.context_main

val make_pdf_mode_environments : unit -> (Typeenv.t * environment, config_error) result
val make_pdf_mode_environments : runtime_config -> (Typeenv.t * environment, config_error) result

val make_text_mode_environments : unit -> (Typeenv.t * environment, config_error) result
val make_text_mode_environments : runtime_config -> (Typeenv.t * environment, config_error) result

val default_radical : HorzBox.radical
27 changes: 17 additions & 10 deletions src/frontend/types.cppo.ml
Original file line number Diff line number Diff line change
Expand Up @@ -681,6 +681,10 @@ type page_break_style =
| MultiColumn of length list
[@@deriving show { with_path = false; }]

type runtime_config = {
job_directory : string; (* Tracks an absolute path to a directory *)
}

type base_constant =
| BCUnit
| BCBool of bool
Expand Down Expand Up @@ -720,9 +724,14 @@ and binding =
| Bind of stage * rec_or_nonrec
| BindTest of EvalVarID.t * string * abstract_tree

and environment =
location EvalVarIDMap.t * (syntactic_value StoreIDHashTable.t) ref
[@printer (fun fmt _ -> Format.fprintf fmt "<env>")]
and environment = {
env_main : location EvalVarIDMap.t;
[@printer (fun fmt _ -> Format.fprintf fmt "<env-main>")]
env_store : (syntactic_value StoreIDHashTable.t) ref;
[@printer (fun fmt _ -> Format.fprintf fmt "<env-store>")]
env_config : runtime_config;
[@printer (fun fmt _ -> Format.fprintf fmt "<env-config>")]
}

and location =
syntactic_value ref
Expand Down Expand Up @@ -1324,24 +1333,22 @@ let get_range (rng, _) = rng


let add_to_environment (env : environment) (evid : EvalVarID.t) (rfast : location) : environment =
let (valenv, stenvref) = env in
(valenv |> EvalVarIDMap.add evid rfast, stenvref)
{ env with env_main = env.env_main |> EvalVarIDMap.add evid rfast }


let find_in_environment (env : environment) (evid : EvalVarID.t) : location option =
let (valenv, _) = env in
valenv |> EvalVarIDMap.find_opt evid
env.env_main |> EvalVarIDMap.find_opt evid


let register_location (env : environment) (value : syntactic_value) : StoreID.t =
let (_, stenvref) = env in
let stenvref = env.env_store in
let stid = StoreID.fresh () in
StoreIDHashTable.add (!stenvref) stid value;
stid


let update_location (env : environment) (stid : StoreID.t) (value : syntactic_value) : unit =
let (_, stenvref) = env in
let stenvref = env.env_store in
let stenv = !stenvref in
if StoreIDHashTable.mem stenv stid then
StoreIDHashTable.replace stenv stid value
Expand All @@ -1350,7 +1357,7 @@ let update_location (env : environment) (stid : StoreID.t) (value : syntactic_va


let find_location_value (env : environment) (stid : StoreID.t) : syntactic_value option =
let (_, stenvref) = env in
let stenvref = env.env_store in
StoreIDHashTable.find_opt (!stenvref) stid


Expand Down
Loading

0 comments on commit 4c8a575

Please sign in to comment.